home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / pcl-cvs / pcl-cvs.el.z / pcl-cvs.el
Encoding:
Text File  |  1998-05-21  |  123.3 KB  |  3,572 lines
  1. ;;;
  2. ;;;#ident "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp "
  3. ;;;
  4. ;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name:  $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $"
  5. ;;;
  6. ;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later.
  7. ;;; Release 1.05-CVS-$Name:  $.
  8. ;;; Copyright (C) 1991, 1992, 1993  Per Cederqvist
  9.  
  10. ;;; This program is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 2 of the License, or
  13. ;;; (at your option) any later version.
  14. ;;;
  15. ;;; This program is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; You should have received a copy of the GNU General Public License
  21. ;;; along with this program; if not, write to the Free Software
  22. ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23. ;;; 02111-1307, USA.
  24.  
  25. ;;; See below for installation instructions.
  26.  
  27. ;;; There is an TeXinfo file that describes this package.  You should read it
  28. ;;; to get the most from this package.
  29.  
  30. ;;; Mail questions and bug reports regarding this version (as included in
  31. ;;; CVS-1.7 or newer) to the pcl-cvs support team at <pcl-cvs@cyclic.com>.
  32.  
  33. ;;; Don't try to use this with CVS 1.2 or earlier.  It won't work.  Get CVS 1.7
  34. ;;; or newer.  Use the version of RCS best suited for the version of CVS you're
  35. ;;; using.
  36.  
  37. (require 'cookie)            ; from ELIB-1.0
  38. (require 'add-log)            ; for all the ChangeLog goodies
  39.  
  40. ;;; -------------------------------------------------------
  41. ;;;        START OF THINGS TO CHECK WHEN INSTALLING
  42.  
  43. ;; also use $GNU here, since may folks might install CVS as a GNU package
  44. ;;
  45. (defun cvs-find-program (program)
  46.   (let ((path (list (getenv "LOCAL")
  47.             (getenv "GNU")
  48.             "/usr/local/bin"
  49.             "/usr/bin"
  50.             "/bin")))
  51.     (while path
  52.       (if (stringp (car path))
  53.       (let ((abs-program (expand-file-name program (car path))))
  54.         (if (file-executable-p abs-program)
  55.         (setq path nil
  56.               program abs-program))))
  57.       (setq path (cdr path)))
  58.     program))
  59.  
  60. (defvar cvs-program (cvs-find-program "cvs")
  61.   "*Full path to the cvs executable.")
  62.  
  63. ;; SunOS-4.1.1_U1 has "diff.c 1.12 88/08/04 SMI; from UCB 4.6 86/04/03"
  64. ;;
  65. (defvar cvs-diff-program (cvs-find-program "diff")
  66.   "*Full path to the best diff program you've got.
  67. NOTE:  there are some nasty bugs in the context diff variants of some vendor
  68. versions, such as the one in SunOS-4.1.1_U1")
  69.  
  70. (defvar cvs-rmdir-program "/bin/rmdir"
  71.   "*Full path to the rmdir program.  Typically /bin/rmdir.")
  72.  
  73. (defvar cvs-shell "/bin/sh"
  74.   "*Full path to a shell that can do redirection on stdout.")
  75.  
  76. ;;; Options to control various features:
  77.  
  78. (defvar cvs-changelog-full-paragraphs t
  79.   "If non-nil, include full ChangeLog paragraphs in the CVS log.
  80. This may be set in the ``local variables'' section of a ChangeLog, to
  81. indicate the policy for that ChangeLog.
  82.  
  83. A ChangeLog paragraph is a bunch of log text containing no blank lines;
  84. a paragraph usually describes a set of changes with a single purpose,
  85. but perhaps spanning several functions in several files.  Changes in
  86. different paragraphs are unrelated.
  87.  
  88. You could argue that the CVS log entry for a file should contain the
  89. full ChangeLog paragraph mentioning the change to the file, even though
  90. it may mention other files, because that gives you the full context you
  91. need to understand the change.  This is the behaviour you get when this
  92. variable is set to t.
  93.  
  94. On the other hand, you could argue that the CVS log entry for a change
  95. should contain only the text for the changes which occurred in that
  96. file, because the CVS log is per-file.  This is the behaviour you get
  97. when this variable is set to nil.")
  98.  
  99. (defvar cvs-cvsroot-required nil
  100.   "*Specifies whether CVS needs to be told where the repository is.
  101.  
  102. In CVS 1.3, if your CVSROOT environment variable is not set, and you
  103. do not set the `cvs-cvsroot' lisp variable, CVS will have no idea
  104. where to find the repository, and refuse to run.  CVS 1.4 and later
  105. store the repository path with the working directories, so most
  106. operations don't need to be told where the repository is.
  107.  
  108. If you work with multiple repositories with CVS 1.4, it's probably
  109. advisable to leave your CVSROOT environment variable unset, set this
  110. variable to nil, and let CVS figure out where the repository is for
  111. itself.")
  112.  
  113. (defvar cvs-cvsroot nil
  114.   "*Specifies where the (current) cvs master repository is.
  115. Overrides the $CVSROOT variable by sending \" -d dir\" to all cvs commands.
  116. This switch is useful if you have multiple CVS repositories, and are not using
  117. a modern version of CVS that stores the current repository in CVS/Root.")
  118.  
  119. ;; Uncomment the following line if you are running on 18.57 or earlier.
  120. ;(setq delete-exited-processes nil)
  121. ;; Emacs version 18.57 and earlier is likely to crash if
  122. ;; delete-exited-processes is t, since the sentinel uses lots of
  123. ;; memory, and 18.57 forgets to GCPROT a variable if
  124. ;; delete-exited-processes is t.
  125.  
  126. ;;;         END OF THINGS TO CHECK WHEN INSTALLING
  127. ;;; --------------------------------------------------------
  128.  
  129. (defconst pcl-cvs-version "1.05-CVS-$Name:  $"
  130.   "A string denoting the current release version of pcl-cvs.")
  131.  
  132. ;; You are NOT allowed to disable this message by default.  However, you
  133. ;; are encouraged to inform your users that by adding
  134. ;;    (setq cvs-inhibit-copyright-message t)
  135. ;; to their .emacs they can get rid of it.  Just don't add that line
  136. ;; to your default.el!
  137. (defvar cvs-inhibit-copyright-message nil
  138.   "*Non-nil means don't display a Copyright message in the ``*cvs*'' buffer.")
  139.  
  140. (defconst cvs-startup-message
  141.   (if cvs-inhibit-copyright-message
  142.       "PCL-CVS release 1.05-CVS-$Name:  $"
  143.     "PCL-CVS release 1.05 from CVS release $Name:  $.
  144. Copyright (C) 1992, 1993 Per Cederqvist
  145. Pcl-cvs comes with absolutely no warranty; for details consult the manual.
  146. This is free software, and you are welcome to redistribute it under certain
  147. conditions; again, consult the TeXinfo manual for details.")
  148.   "*Startup message for CVS.")
  149.  
  150. (defconst pcl-cvs-bugs-address "pcl-cvs-auto-bugs@cyclic.com"
  151.   "The destination address used for the default bug report form.")
  152.  
  153. (defvar cvs-stdout-file nil
  154.   "Name of the file that holds the output that CVS sends to stdout.
  155. This variable is buffer local.")
  156.  
  157. (defvar cvs-lock-file nil
  158.   "Full path to a lock file that CVS is waiting for (or was waiting for).")
  159.  
  160. (defvar cvs-bakprefix ".#"
  161.   "The prefix that CVS prepends to files when rcsmerge'ing.")
  162.  
  163. (defvar cvs-erase-input-buffer nil
  164.   "*Non-nil if input buffers should be cleared before asking for new info.")
  165.  
  166. (defvar cvs-auto-remove-handled nil
  167.   "*Non-nil if cvs-mode-remove-handled should be called automatically.
  168. If this is set to any non-nil value, entries that do not need to be checked in
  169. will be removed from the *cvs* buffer after every cvs-mode-commit command.")
  170.  
  171. (defvar cvs-auto-remove-handled-directories nil
  172.   "*Non-nil if cvs-mode-remove-handled and cvs-update should automatically
  173. remove empty directories.
  174. If this is set to any non-nil value, directories that do not contain any files
  175. to be checked in will be removed from the *cvs* buffer.")
  176.  
  177. (defvar cvs-sort-ignore-file t
  178.   "*Non-nil if cvs-mode-ignore should sort the .cvsignore automatically.")
  179.  
  180. (defvar cvs-auto-revert-after-commit t
  181.   "*Non-nil if committed buffers should be automatically reverted.")
  182.  
  183. (defconst cvs-cursor-column 14
  184.   "Column to position cursor in in cvs-mode.
  185. Column 0 is left-most column.")
  186.  
  187. (defvar cvs-mode-map nil
  188.   "Keymap for the cvs mode.")
  189.  
  190. (defvar cvs-edit-mode-map nil
  191.   "Keymap for the cvs edit mode (used when editing cvs log messages).")
  192.  
  193. (defvar cvs-buffer-name "*cvs*"
  194.   "Name of the cvs buffer.")
  195.  
  196. (defvar cvs-commit-prompt-buffer "*cvs-commit-message*"
  197.   "Name of buffer in which the user is prompted for a log message when
  198. committing files.")
  199.  
  200. (defvar cvs-commit-buffer-require-final-newline t
  201.   "*t says silently put a newline at the end of commit log messages.
  202. Non-nil but not t says ask user whether to add a newline in each such case.
  203. nil means don't add newlines.")
  204.  
  205. (defvar cvs-temp-buffer-name "*cvs-tmp*"
  206.   "*Name of the cvs temporary buffer.
  207. Output from cvs is placed here by synchronous commands.")
  208.  
  209. (defvar cvs-diff-ignore-marks nil
  210.   "*Non-nil if cvs-diff and cvs-mode-diff-backup should ignore any marked files.
  211. Normally they run diff on the files that are marked (with cvs-mode-mark),
  212. or the file under the cursor if no files are marked.  If this variable
  213. is set to a non-nil value they will always run diff on the file on the
  214. current line.")
  215.  
  216. ;;; (setq cvs-status-flags '("-v"))
  217. (defvar cvs-status-flags '("-v")
  218.   "*List of flags to pass to ``cvs status''.  Default is \"-v\".")
  219.  
  220. ;;; (setq cvs-log-flags nil)
  221. (defvar cvs-log-flags nil
  222.   "*List of flags to pass to ``cvs log''.  Default is none.")
  223.  
  224. ;;; (setq cvs-tag-flags nil)
  225. (defvar cvs-tag-flags nil
  226.   "*List of extra flags to pass to ``cvs tag''.  Default is none.")
  227.  
  228. ;;; (setq cvs-rtag-flags nil)
  229. (defvar cvs-rtag-flags nil
  230.   "*List of extra flags to pass to ``cvs rtag''.  Default is none.")
  231.  
  232. ;;; (setq cvs-diff-flags '("-u"))
  233. (defvar cvs-diff-flags '("-u")
  234.   "*List of flags to use as flags to pass to ``diff'' and ``cvs diff''.
  235. Used by cvs-mode-diff-cvs, cvs-mode-diff-head and cvs-mode-diff-backup.
  236. Default is \"-u\".
  237.  
  238. Set this to \"-u\" to get a Unidiff format, or \"-c\" to get context diffs.")
  239.  
  240. ;;; (setq cvs-update-optional-flags nil)
  241. (defvar cvs-update-optional-flags nil
  242.   "*List of strings to use as optional flags to pass to ``cvs update''.  Used
  243. by cvs-do-update, called by cvs-update, cvs-update-other-window,
  244. cvs-mode-update-no-prompt, and cvs-examine.  Default is none.
  245.  
  246. For example set this to \"-j VENDOR_PREV_RELEASE -j VENDOR_TOP_RELEASE\" to
  247. perform an update after a new vendor release has been imported.
  248.  
  249. To restrict the update to the current working directory, set this to \"-l\".")
  250.  
  251. (defvar cvs-update-prog-output-skip-regexp "$"
  252.   "*A regexp that matches the end of the output from all cvs update programs.
  253. That is, output from any programs that are run by CVS (by the flag -u in the
  254. `modules' file - see cvs(5)) when `cvs update' is performed should terminate
  255. with a line that this regexp matches.  It is enough that some part of the line
  256. is matched.
  257.  
  258. The default (a single $) fits programs without output.")
  259.  
  260. ;;; --------------------------------------------------------
  261. ;;; The variables below are used internally by pcl-cvs.  You should
  262. ;;; never change them.
  263.  
  264. (defvar cvs-buffers-to-delete nil
  265.   "List of temporary buffers that should be discarded as soon as possible.
  266. Due to a bug in emacs 18.57 the sentinel can't discard them reliably.")
  267.  
  268. (defvar cvs-update-running nil
  269.   "This is set to nil when no process is running, and to
  270. the process when a cvs update process is running.")
  271.  
  272. (defvar cvs-cookie-handle nil
  273.   "Handle for the cookie structure that is displayed in the *cvs* buffer.")
  274.  
  275. (defvar cvs-commit-list nil
  276.   "Used internally by pcl-cvs.")
  277.  
  278. ;;; The cvs data structure:
  279. ;;;
  280. ;;; When the `cvs update' is ready we parse the output.  Every file
  281. ;;; that is affected in some way is added as a cookie of fileinfo
  282. ;;; (as defined below).
  283. ;;;
  284.  
  285. ;;; cvs-fileinfo
  286.  
  287. ;;; Constructor:
  288.  
  289. (defun cvs-create-fileinfo (type
  290.                 dir
  291.                 file-name
  292.                 full-log)
  293.   "Create a fileinfo from all parameters.
  294. Arguments:  TYPE DIR FILE-NAME FULL-LOG.
  295. A fileinfo is a vector with the following fields:
  296.  
  297. [0]  handled          True if this file doesn't require further action.
  298. [1]  marked          t/nil
  299. [2]  type          One of
  300.             UPDATED       - file copied from repository
  301.             PATCHED       - file update with patch from repository
  302.             MODIFIED   - modified by you, unchanged in
  303.                      repository
  304.             ADDED       - added by you, not yet committed
  305.             REMOVED       - removed by you, not yet committed
  306.             CVS-REMOVED- removed, since file no longer exists
  307.                      in the repository.
  308.             MERGED       - successful merge
  309.             CONFLICT   - conflict when merging (if pcl-cvs did it)
  310.             REM-CONFLICT-removed in repository, but altered
  311.                      locally.
  312.             MOD-CONFLICT-removed locally, changed in repository.
  313.                         REM-EXIST  - removed locally, but still exists.
  314.             DIRCHANGE  - A change of directory.
  315.             UNKNOWN       - An unknown file.
  316.             UNKNOWN-DIR- An unknown directory.
  317.             MOVE-AWAY  - A file that is in the way.
  318.             REPOS-MISSING- The directory has vanished from the
  319.                        repository.
  320.                         MESSAGE    - This is a special fileinfo that is used
  321.                          to display a text that should be in
  322.                                        full-log.
  323. [3]  dir          Directory the file resides in.  Should not end with slash.
  324. [4]  file-name          The file name.
  325. [5]  backup-file      The name of a backup file created during a merge.
  326.                         Only valid for MERGED and CONFLICT files.
  327. [6]  base-revision    The revision that the working file was based on.
  328.                         Only valid for MERGED and CONFLICT files.
  329. [7]  head-revision    The revision that the newly merged changes came from
  330.                         Only valid for MERGED and CONFLICT files.
  331. [8]  backup-revision  The revision of the cvs backup file (original working rev.)
  332.                         Only valid for MERGED and CONFLICT files.
  333. [9]  cvs-diff-buffer  A buffer that contains a 'cvs diff file'.
  334. [10] vendor-diff-buffer  A buffer that contains a 'diff base-file head-file'.
  335. [11] backup-diff-buffer  A buffer that contains a 'diff file backup-file'.
  336. [12] full-log          The output from cvs, unparsed.
  337. [13] mod-time          Modification time of file used for *-diff-buffer."
  338.  
  339.   (cons
  340.    'CVS-FILEINFO
  341.    (vector nil nil type dir file-name nil nil nil nil nil nil nil full-log nil nil)))
  342.  
  343. ;;; Selectors:
  344.  
  345. (defun cvs-fileinfo->handled (cvs-fileinfo)
  346.   "Get the  `handled' field from CVS-FILEINFO."
  347.   (elt (cdr cvs-fileinfo) 0))
  348.  
  349. (defun cvs-fileinfo->marked (cvs-fileinfo)
  350.   "Check if CVS-FILEINFO is marked."
  351.   (elt (cdr cvs-fileinfo) 1))
  352.  
  353. (defun cvs-fileinfo->type (cvs-fileinfo)
  354.   "Get type from CVS-FILEINFO.
  355. Type is one of UPDATED, PATCHED, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED,
  356. CONFLICT, REM-CONFLICT, MOD-CONFLICT, REM-EXIST, DIRCHANGE, UNKNOWN,
  357. UNKNOWN-DIR, MOVE-AWAY, REPOS-MISSING or MESSAGE."
  358.   (elt (cdr cvs-fileinfo) 2))
  359.  
  360. (defun cvs-fileinfo->dir (cvs-fileinfo)
  361.   "Get dir from CVS-FILEINFO.
  362. The directory name does not end with a slash."
  363.   (elt (cdr cvs-fileinfo) 3))
  364.  
  365. (defun cvs-fileinfo->file-name (cvs-fileinfo)
  366.   "Get file-name from CVS-FILEINFO."
  367.   (elt (cdr cvs-fileinfo) 4))
  368.  
  369. (defun cvs-fileinfo->backup-file (cvs-fileinfo)
  370.   "Get backup-file from CVS-FILEINFO."
  371.   (elt (cdr cvs-fileinfo) 5))
  372.  
  373. (defun cvs-fileinfo->base-revision (cvs-fileinfo)
  374.   "Get the base revision from CVS-FILEINFO."
  375.   (elt (cdr cvs-fileinfo) 6))
  376.  
  377. (defun cvs-fileinfo->head-revision (cvs-fileinfo)
  378.   "Get the head revision from CVS-FILEINFO."
  379.   (elt (cdr cvs-fileinfo) 7))
  380.  
  381. (defun cvs-fileinfo->backup-revision (cvs-fileinfo)
  382.   "Get the backup revision from CVS-FILEINFO."
  383.   (elt (cdr cvs-fileinfo) 8))
  384.  
  385. (defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo)
  386.   "Get cvs-diff-buffer from CVS-FILEINFO."
  387.   (elt (cdr cvs-fileinfo) 9))
  388.  
  389. (defun cvs-fileinfo->vendor-diff-buffer (cvs-fileinfo)
  390.   "Get backup-diff-buffer from CVS-FILEINFO."
  391.   (elt (cdr cvs-fileinfo) 10))
  392.  
  393. (defun cvs-fileinfo->backup-diff-buffer (cvs-fileinfo)
  394.   "Get backup-diff-buffer from CVS-FILEINFO."
  395.   (elt (cdr cvs-fileinfo) 11))
  396.  
  397. (defun cvs-fileinfo->full-log (cvs-fileinfo)
  398.   "Get full-log from CVS-FILEINFO."
  399.   (elt (cdr cvs-fileinfo) 12))
  400.  
  401. (defun cvs-fileinfo->mod-time (cvs-fileinfo)
  402.   "Get mod-time from CVS-FILEINFO."
  403.   (elt (cdr cvs-fileinfo) 13))
  404.  
  405. ;;; Modifiers:
  406.  
  407. (defun cvs-set-fileinfo->handled (cvs-fileinfo newval)
  408.   "Set handled in CVS-FILEINFO to NEWVAL."
  409.   (aset (cdr cvs-fileinfo) 0 newval))
  410.  
  411. (defun cvs-set-fileinfo->marked (cvs-fileinfo newval)
  412.   "Set marked in CVS-FILEINFO to NEWVAL."
  413.   (aset (cdr cvs-fileinfo) 1 newval))
  414.  
  415. (defun cvs-set-fileinfo->type (cvs-fileinfo newval)
  416.   "Set type in CVS-FILEINFO to NEWVAL."
  417.   (aset (cdr cvs-fileinfo) 2 newval))
  418.  
  419. (defun cvs-set-fileinfo->dir (cvs-fileinfo newval)
  420.   "Set dir in CVS-FILEINFO to NEWVAL.
  421. The directory should now end with a slash."
  422.   (aset (cdr cvs-fileinfo) 3 newval))
  423.  
  424. (defun cvs-set-fileinfo->file-name (cvs-fileinfo newval)
  425.   "Set file-name in CVS-FILEINFO to NEWVAL."
  426.   (aset (cdr cvs-fileinfo) 4 newval))
  427.  
  428. (defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval)
  429.   "Set backup-file in CVS-FILEINFO to NEWVAL."
  430.   (aset (cdr cvs-fileinfo) 5 newval))
  431.  
  432. (defun cvs-set-fileinfo->base-revision (cvs-fileinfo newval)
  433.   "Set base-revision in CVS-FILEINFO to NEWVAL."
  434.   (aset (cdr cvs-fileinfo) 6 newval))
  435.  
  436. (defun cvs-set-fileinfo->head-revision (cvs-fileinfo newval)
  437.   "Set head-revision in CVS-FILEINFO to NEWVAL."
  438.   (aset (cdr cvs-fileinfo) 7 newval))
  439.  
  440. (defun cvs-set-fileinfo->backup-revision (cvs-fileinfo newval)
  441.   "Set backup-revision in CVS-FILEINFO to NEWVAL."
  442.   (aset (cdr cvs-fileinfo) 8 newval))
  443.  
  444. (defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval)
  445.   "Set cvs-diff-buffer in CVS-FILEINFO to NEWVAL."
  446.   (aset (cdr cvs-fileinfo) 9 newval))
  447.  
  448. (defun cvs-set-fileinfo->vendor-diff-buffer (cvs-fileinfo newval)
  449.   "Set vendor-diff-buffer in CVS-FILEINFO to NEWVAL."
  450.   (aset (cdr cvs-fileinfo) 10 newval))
  451.  
  452. (defun cvs-set-fileinfo->backup-diff-buffer (cvs-fileinfo newval)
  453.   "Set backup-diff-buffer in CVS-FILEINFO to NEWVAL."
  454.   (aset (cdr cvs-fileinfo) 11 newval))
  455.  
  456. (defun cvs-set-fileinfo->full-log (cvs-fileinfo newval)
  457.   "Set full-log in CVS-FILEINFO to NEWVAL."
  458.   (aset (cdr cvs-fileinfo) 12 newval))
  459.  
  460. (defun cvs-set-fileinfo->mod-time (cvs-fileinfo newval)
  461.   "Set full-log in CVS-FILEINFO to NEWVAL."
  462.   (aset (cdr cvs-fileinfo) 13 newval))
  463.  
  464. ;;; Predicate:
  465.  
  466. (defun cvs-fileinfo-p (object)
  467.   "Return t if OBJECT is a cvs-fileinfo."
  468.   (eq (car-safe object) 'CVS-FILEINFO))
  469.  
  470. ;;;; End of types.
  471.  
  472. ;;----------
  473. (defun cvs-use-temp-buffer ()
  474.   "Display a temporary buffer in another window and select it.
  475. The selected window will not be changed.  The temporary buffer will
  476. be erased and writable."
  477.  
  478.   (let ((dir default-directory))
  479.     (display-buffer (get-buffer-create cvs-temp-buffer-name))
  480.     (set-buffer cvs-temp-buffer-name)
  481.     (setq buffer-read-only nil)
  482.     (setq default-directory dir)
  483.     (erase-buffer)))
  484.  
  485. ;;----------
  486. (defun cvs-examine (directory &optional local)
  487.   "Run a 'cvs -n update' in the current working directory.
  488. That is, check what needs to be done, but don't change the disc.
  489. Feed the output to a *cvs* buffer and run cvs-mode on it.
  490. If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run.
  491. WARNING:  this doesn't work very well yet...."
  492.  
  493.   ;; TODO:  this should do everything cvs-update does...
  494.   ;; for example, for CONFLICT files, it should setup fileinfo appropriately
  495.  
  496.   (interactive (list (read-file-name "CVS Update (directory): "
  497.                      nil default-directory nil)
  498.              current-prefix-arg))
  499.   (cvs-do-update directory local 'noupdate))
  500.  
  501. ;;----------
  502. ;;;###autoload
  503. (defun cvs-update (directory &optional local)
  504.   "Run a 'cvs update' in the current working directory.  Feed the
  505. output to a *cvs* buffer and run cvs-mode on it.
  506. If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
  507.  
  508.   (interactive (list (read-file-name "CVS Update (directory): "
  509.                      nil default-directory nil)
  510.              current-prefix-arg))
  511.   ;; If the previous prompt was in a dialog box, the save-some-buffers
  512.   ;; call in cvs-do-update will lose.
  513.   (let ((use-dialog-box nil))
  514.     (cvs-do-update directory local nil))
  515.   (switch-to-buffer cvs-buffer-name))
  516.  
  517. ;;----------
  518. ;;;###autoload
  519. (defun cvs-update-other-window (directory &optional local)
  520.   "Run a 'cvs update' in the current working directory.  Feed the
  521. output to a *cvs* buffer, display it in the other window, and run
  522. cvs-mode on it.
  523.  
  524. If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
  525.  
  526.   (interactive (list (read-file-name "CVS Update other window (directory): "
  527.                      nil default-directory nil)
  528.              current-prefix-arg))
  529.   (cvs-do-update directory local nil)
  530.   (switch-to-buffer-other-window cvs-buffer-name))
  531.  
  532. ;;----------
  533. (defun cvs-filter (predicate list &rest extra-args)
  534.   "Apply PREDICATE to each element on LIST.
  535. Args:  PREDICATE LIST &rest EXTRA-ARGS.
  536.  
  537. Return a new list consisting of those elements that PREDICATE
  538. returns non-nil for.
  539.  
  540. If more than two arguments are given the remaining args are
  541. passed to PREDICATE."
  542.  
  543.   ;; Avoid recursion - this should work for LONG lists also!
  544.   (let* ((head (cons 'dummy-header nil))
  545.      (tail head))
  546.     (while list
  547.       (if (apply predicate (car list) extra-args)
  548.       (setq tail (setcdr tail (list (car list)))))
  549.       (setq list (cdr list)))
  550.     (cdr head)))
  551.  
  552. ;;----------
  553. (defun cvs-mode-update-no-prompt ()
  554.   "Run cvs update in current directory."
  555.  
  556.   (interactive)
  557.   (cvs-do-update default-directory nil nil))
  558.  
  559. ;;----------
  560. (defun cvs-do-update (directory local dont-change-disc)
  561.   "Do a 'cvs update' in DIRECTORY.
  562. Args:  DIRECTORY LOCAL DONT-CHANGE-DISC.
  563.  
  564. If LOCAL is non-nil 'cvs update -l' is executed.
  565. If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed.
  566. Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously.
  567.  
  568. *Note*:  DONT-CHANGE-DISC does not yet work.  The parser gets confused."
  569.  
  570.   (save-some-buffers)
  571.   ;; Ensure that it is safe to do an update.  If not, ask user
  572.   ;; for confirmation.
  573.   (if (and (boundp 'cvs-cookie-handle) (collection-buffer cvs-cookie-handle))
  574.       (if (collection-collect-tin
  575.        cvs-cookie-handle
  576.        '(lambda (cookie) (eq (cvs-fileinfo->type cookie) 'CONFLICT)))
  577.       (if (not
  578.            (yes-or-no-p
  579.         "Only update if conflicts have been resolved.  Continue? "))
  580.           (error "Update aborted by user request."))))
  581.   (if (not (file-exists-p cvs-program))
  582.       (error "%s: file not found (check setting of cvs-program)"
  583.          cvs-program))
  584.   (let* ((this-dir (file-name-as-directory (expand-file-name directory)))
  585.      (update-buffer (generate-new-buffer
  586.              (concat " " (file-name-nondirectory
  587.                       (substring this-dir 0 -1))
  588.                  "-update")))
  589.      (temp-name (make-temp-name
  590.              (concat (file-name-as-directory
  591.                   (or (getenv "TMPDIR") "/tmp"))
  592.                  "pcl-cvs.")))
  593.      (args nil))
  594.  
  595.     ;; Check that this-dir exists and is a directory that is under CVS contr.
  596.  
  597.     (if (not (file-directory-p this-dir))
  598.     (error "%s is not a directory." this-dir))
  599.     (if (not (file-directory-p (concat this-dir "CVS")))
  600.     (error "%s does not contain CVS controlled files." this-dir))
  601.     (if (file-readable-p (concat this-dir "CVS/Root"))
  602.     (save-excursion        ; read CVS/Root into cvs-cvsroot
  603.       (find-file (concat this-dir "CVS/Root"))
  604.       (goto-char (point-min))
  605.       (setq cvs-cvsroot (buffer-substring (point)
  606.                           (progn (end-of-line) (point))))
  607.       (if (not cvs-cvsroot)
  608.           (error "Invalid contents of %sCVS/Root" this-dir))
  609.       (kill-buffer (current-buffer)))
  610.       (if (and cvs-cvsroot-required
  611.            (not (or (getenv "CVSROOT") cvs-cvsroot)))
  612.       (error "Both cvs-cvsroot and environment variable CVSROOT are unset, and no CVS/Root.")))
  613.  
  614.     ;; Check that at most one `cvs update' is run at any time.
  615.  
  616.     (if (and cvs-update-running (process-status cvs-update-running)
  617.          (or (eq (process-status cvs-update-running) 'run)
  618.          (eq (process-status cvs-update-running) 'stop)))
  619.     (error "Can't run two `cvs update' simultaneously."))
  620.  
  621.     (if (not (listp cvs-update-optional-flags))
  622.     (error "cvs-update-optional-flags should be set using cvs-set-update-optional-flags"))
  623.  
  624.     ;; Generate "-d /master -n update -l".
  625.     (setq args (concat (if cvs-cvsroot (concat " -d " cvs-cvsroot))
  626.                (if dont-change-disc " -n ")
  627.                " update "
  628.                (if local " -l ")
  629.                (if cvs-update-optional-flags
  630.                (mapconcat 'identity
  631.                       (copy-sequence cvs-update-optional-flags)
  632.                       " "))))
  633.  
  634.     ;; Set up the buffer that receives the stderr output from "cvs update".
  635.     (set-buffer update-buffer)
  636.     (setq default-directory this-dir)
  637.     (make-local-variable 'cvs-stdout-file)
  638.     (setq cvs-stdout-file temp-name)
  639.  
  640.     (setq cvs-update-running
  641.       (let ((process-connection-type nil)) ; Use a pipe, not a pty.
  642.         (start-process "cvs" update-buffer cvs-shell "-c"
  643.                (concat cvs-program " " args " > " temp-name))))
  644.  
  645.     (setq mode-line-process
  646.       (concat ": "
  647.           (symbol-name (process-status cvs-update-running))))
  648.     ; XEmacs change
  649.     (redraw-modeline)    ; Update the mode line.
  650.     (set-process-sentinel cvs-update-running 'cvs-sentinel)
  651.     (set-process-filter cvs-update-running 'cvs-update-filter)
  652.     (set-marker (process-mark cvs-update-running) (point-min))
  653.  
  654.     (save-excursion
  655.       (set-buffer (get-buffer-create cvs-buffer-name))
  656.       (setq buffer-read-only nil)
  657.       (erase-buffer)
  658.       (cvs-mode))
  659.       
  660.     (setq cvs-cookie-handle
  661.       (collection-create
  662.        cvs-buffer-name 'cvs-pp
  663.        cvs-startup-message        ;See comment above cvs-startup-message.
  664.        "---------- End -----"))
  665.  
  666.     (cookie-enter-first
  667.      cvs-cookie-handle
  668.      (cvs-create-fileinfo
  669.       'MESSAGE nil nil (concat "\n    Running `cvs " args "' in " this-dir
  670.                    "...\n")))
  671.  
  672.     (save-excursion
  673.       (set-buffer cvs-buffer-name)
  674.       (setq mode-line-process
  675.         (concat ": "
  676.             (symbol-name (process-status cvs-update-running))))
  677.       ; XEmacs change
  678.       (redraw-modeline)    ; Update the mode line.
  679.       (setq buffer-read-only t))
  680.  
  681.     ;; Work around a bug in emacs 18.57 and earlier.
  682.     (setq cvs-buffers-to-delete
  683.       (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete)))
  684.  
  685.   ;; The following line is said to improve display updates on some
  686.   ;; emacses.  It shouldn't be needed, but it does no harm.
  687.   (sit-for 0))
  688.  
  689. ;;----------
  690. (defun cvs-delete-unused-temporary-buffers (list)
  691.   "Delete all buffers on LIST that is not visible.
  692. Return a list of all buffers that still is alive."
  693.  
  694.   (cond
  695.    ((null list) nil)
  696.    ((get-buffer-window (car list))
  697.     (cons (car list)
  698.       (cvs-delete-unused-temporary-buffers (cdr list))))
  699.    (t
  700.     (kill-buffer (car list))
  701.     (cvs-delete-unused-temporary-buffers (cdr list)))))
  702.  
  703. ;;----------
  704. (put 'cvs-mode 'mode-class 'special)
  705.  
  706. ;;----------
  707. (defun cvs-mode ()
  708.   "\\<cvs-mode-map>Mode used for pcl-cvs, a front-end to CVS.
  709.  
  710. To get to the \"*cvs*\" buffer you should use ``\\[execute-extended-command] cvs-update''.
  711.  
  712. Full documentation is in the Texinfo file.  Here are the most useful commands:
  713.  
  714. \\[cvs-mode-previous-line] Move up.                    \\[cvs-mode-next-line] Move down.
  715. \\[cvs-mode-commit]   Commit file.                \\[cvs-mode-update-no-prompt]   Re-update directory.
  716. \\[cvs-mode-mark]   Mark file/dir.              \\[cvs-mode-unmark]   Unmark file/dir.
  717. \\[cvs-mode-mark-all-files]   Mark all files.             \\[cvs-mode-unmark-all-files]   Unmark all files.
  718. \\[cvs-mode-find-file]   Edit file/run Dired.        \\[cvs-mode-find-file-other-window]   Find file or run Dired in other window.
  719. \\[cvs-mode-ignore]   Add file to ./.cvsignore.   \\[cvs-mode-add-change-log-entry-other-window]   Write ChangeLog in other window.
  720. \\[cvs-mode-add]   Add to repository.          \\[cvs-mode-remove-file]   Remove file.
  721. \\[cvs-mode-diff-cvs]   Diff with base revision.    \\[cvs-mode-diff-backup]   Diff backup file.
  722. \\[cvs-mode-diff-head]   Diff with head revision.
  723. \\[cvs-mode-ediff]   Ediff base rev & backup.    \\[cvs-mode-diff-vendor]   Show merge from vendor branch.
  724. \\[cvs-mode-emerge]   Emerge base rev & backup.   \\[cvs-mode-diff-backup]   Diff backup file.
  725. \\[cvs-mode-acknowledge] Delete line from buffer.    \\[cvs-mode-remove-handled]   Remove processed entries.   
  726. \\[cvs-mode-log]   Run ``cvs log''.            \\[cvs-mode-status]   Run ``cvs status''.
  727. \\[cvs-mode-tag]   Run ``cvs tag''.            \\[cvs-mode-rtag]   Run ``cvs rtag''.
  728. \\[cvs-mode-changelog-commit]   Like \\[cvs-mode-commit], but get default log text from ChangeLog.
  729. \\[cvs-mode-undo-local-changes]   Revert the last checked in version - discard your changes to the file.
  730.  
  731. Entry to this mode runs cvs-mode-hook.
  732. This description is updated for release 1.05-CVS-$Name:  $ of pcl-cvs.
  733.  
  734. All bindings:
  735. \\{cvs-mode-map}"
  736.  
  737.   (interactive)
  738.   (setq major-mode 'cvs-mode)
  739.   (setq mode-name "CVS")
  740.   (setq mode-line-process nil)
  741. ;; for older v18 emacs
  742. ;;(buffer-flush-undo (current-buffer))
  743.   (buffer-disable-undo (current-buffer))
  744.   (make-local-variable 'goal-column)
  745.   (setq goal-column cvs-cursor-column)
  746.   (use-local-map cvs-mode-map)
  747.   (run-hooks 'cvs-mode-hook))
  748.  
  749. ;;----------
  750. (defun cvs-sentinel (proc msg)
  751.   "Sentinel for the cvs update process.
  752. This is responsible for parsing the output from the cvs update when
  753. it is finished."
  754.  
  755.   (cond
  756.    ((null (buffer-name (process-buffer proc)))
  757.     ;; buffer killed
  758.     (set-process-buffer proc nil))
  759.    ((memq (process-status proc) '(signal exit))
  760.     (let* ((obuf (current-buffer))
  761.        (omax (point-max))
  762.        (opoint (point)))
  763.       ;; save-excursion isn't the right thing if
  764.       ;;  process-buffer is current-buffer
  765.       (unwind-protect
  766.       (progn
  767.         (set-buffer (process-buffer proc))
  768.         (setq mode-line-process
  769.           (concat ": "
  770.               (symbol-name (process-status proc))))
  771.         (let* ((out-file cvs-stdout-file)
  772.            (stdout-buffer (find-file-noselect out-file)))
  773.           (save-excursion
  774.         (set-buffer stdout-buffer)
  775.         (rename-buffer (concat " "
  776.                        (file-name-nondirectory out-file)) t))
  777.           (cvs-parse-update stdout-buffer (process-buffer proc))
  778.           (setq cvs-buffers-to-delete
  779.             (cons (process-buffer proc)
  780.               (cons stdout-buffer
  781.                 cvs-buffers-to-delete)))
  782.           (delete-file out-file)))
  783.     (message "CVS update process has completed.")   ; XEmacs
  784.     (set-buffer-modified-p (buffer-modified-p))
  785.     (setq cvs-update-running nil))
  786.       (if (equal obuf (process-buffer proc))
  787.       nil
  788.     (set-buffer (process-buffer proc))
  789.     (if (< opoint omax)
  790.         (goto-char opoint))
  791.     (set-buffer obuf))))))
  792.  
  793. ;;----------
  794. (defun cvs-update-filter (proc string)
  795.   "Filter function for pcl-cvs.
  796. This function gets the output that CVS sends to stderr.  It inserts it
  797. into (process-buffer proc) but it also checks if CVS is waiting for a
  798. lock file.  If so, it inserts a message cookie in the *cvs* buffer."
  799.  
  800.   (let ((old-buffer (current-buffer))
  801.     (data (match-data)))
  802.     (unwind-protect
  803.     (progn
  804.            (set-buffer (process-buffer proc))
  805.            (save-excursion
  806.              ;; Insert the text, moving the process-marker.
  807.              (goto-char (process-mark proc))
  808.              (insert string)
  809.              (set-marker (process-mark proc) (point))
  810.         ;; Delete any old lock message
  811.         (if (tin-nth cvs-cookie-handle 1)
  812.         (tin-delete cvs-cookie-handle
  813.                 (tin-nth cvs-cookie-handle 1)))
  814.         ;; Check if CVS is waiting for a lock.
  815.         (beginning-of-line 0)    ;Move to beginning of last
  816.                     ;complete line.
  817.         (cond
  818.          ((looking-at
  819.            "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for \\(.*\\)lock in \\(.*\\)$")
  820.           (setq cvs-lock-file (buffer-substring (match-beginning 3)
  821.                             (match-end 3)))
  822.           (cookie-enter-last
  823.            cvs-cookie-handle
  824.            (cvs-create-fileinfo
  825.         'MESSAGE nil nil
  826.         (concat "\tWaiting for "
  827.             (buffer-substring (match-beginning 2)
  828.                       (match-end 2))
  829.             "lock in " cvs-lock-file
  830.             ".\n\t (type M-x cvs-delete-lock to delete it)")))))))
  831.       (store-match-data data)
  832.       (set-buffer old-buffer))))
  833.  
  834. ;;----------
  835. (defun cvs-delete-lock ()
  836.   "Delete the lock file that CVS is waiting for.
  837. Note that this can be dangerous.  You should only do this
  838. if you are convinced that the process that created the lock is dead."
  839.  
  840.   (interactive)
  841.   (cond
  842.    ((not (or (file-exists-p
  843.           (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))
  844.          (cvs-filter (function cvs-lock-file-p)
  845.              (directory-files cvs-lock-file))))
  846.     (error "No lock files found."))
  847.    ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
  848.     ;; Re-read the directory -- the locks might have disappeared.
  849.     (let ((locks (cvs-filter (function cvs-lock-file-p)
  850.                  (directory-files cvs-lock-file))))
  851.       (while locks
  852.     (delete-file (concat (file-name-as-directory cvs-lock-file)
  853.                  (car locks)))
  854.     (setq locks (cdr locks)))
  855.       (cvs-remove-directory
  856.        (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))))))
  857.  
  858. ;;----------
  859. (defun cvs-remove-directory (dir)
  860.   "Remove a directory."
  861.  
  862.   (if (file-directory-p dir)
  863.       (call-process cvs-rmdir-program nil nil nil dir)
  864.     (error "Not a directory: %s" dir))
  865.   (if (file-exists-p dir)
  866.       (error "Could not remove directory %s" dir)))
  867.  
  868. ;;----------
  869. (defun cvs-lock-file-p (file)
  870.   "Return true if FILE looks like a CVS lock file."
  871.  
  872.   (or
  873.    (string-match "^#cvs.tfl.[0-9]+$" file)
  874.    (string-match "^#cvs.rfl.[0-9]+$" file)
  875.    (string-match "^#cvs.wfl.[0-9]+$" file)))
  876.  
  877. ;;----------
  878. (defun cvs-quote-multiword-string (str)
  879.   "Return STR surrounded in single quotes if it contains whitespace."
  880.   (cond ((string-match "[ \t\n]" str)
  881.      (concat "'" str "'"))
  882.     (t
  883.      str)))
  884.  
  885. ;;----------
  886. ;; this should be in subr.el or some similar place....
  887. (defun parse-string (str &optional regexp)
  888.   "Explode the string STR into a list of words ala strtok(3).  Optional REGEXP
  889. defines regexp matching word separator, which defaults to \"[ \\t\\n]+\"."
  890.   (let (str-list            ; new list
  891.     str-token            ; "index" of next token
  892.     (str-start 0)            ; "index" of current token
  893.     (str-sep (if regexp
  894.              regexp
  895.            "[ \t\n]+")))
  896.     (while (setq str-token (string-match str-sep str str-start))
  897.       (setq str-list
  898.         (nconc str-list
  899.            (list (substring str str-start str-token))))
  900.       (setq str-start (match-end 0)))
  901.     ;; tag on the remainder as the final item
  902.     (if (not (>= str-start (length str)))
  903.     (setq str-list
  904.           (nconc str-list
  905.              (list (substring str str-start)))))
  906.     str-list))
  907.  
  908. ;;----------
  909. (defun cvs-make-list (str)
  910.   "Return list of words made from the string STR."
  911.   (cond ((string-match "[ \t\n]+" str)
  912.      (let ((new-str (parse-string str "[ \t\n]+")))
  913.        ;; this is ugly, but assume if the first element is empty, there are
  914.        ;; no more elements.
  915.        (cond ((string= (car new-str) "")
  916.           nil)
  917.          (t
  918.           new-str))))
  919.     ((string= str "")
  920.      nil)
  921.     (t
  922.      (list str))))
  923.  
  924. ;;----------
  925. (defun cvs-skip-line (stdout stderr regexp &optional arg)
  926.   "Like forward-line, but check that the skipped line matches REGEXP.
  927. Args:  STDOUT STDERR REGEXP &optional ARG.
  928.  
  929. If it doesn't match REGEXP a bug report is generated and displayed.
  930. STDOUT and STDERR is only used to do that.
  931.  
  932. If optional ARG, a number, is given the ARGth parenthesized expression
  933. in the REGEXP is returned as a string.
  934. Point should be in column 1 when this function is called."
  935.  
  936.   (cond
  937.    ((looking-at regexp)
  938.     (forward-line 1)
  939.     (if arg
  940.     (buffer-substring (match-beginning arg)
  941.               (match-end arg))))
  942.    (t
  943.     (cvs-parse-error stdout
  944.              stderr
  945.              (if (eq (current-buffer) stdout)
  946.              'STDOUT
  947.                'STDERR)
  948.              (point)
  949.              regexp))))
  950.  
  951. ;;----------
  952. (defun cvs-get-current-dir (root-dir dirname)
  953.   "Return current working directory, suitable for cvs-parse-update.
  954. Args:  ROOT-DIR DIRNAME.
  955.  
  956. Concatenates ROOT-DIR and DIRNAME to form an absolute path."
  957.  
  958.   (if (string= "." dirname)
  959.       (substring root-dir 0 -1)
  960.     (concat root-dir dirname)))
  961.  
  962. ;;----------
  963. (defun cvs-compare-fileinfos (a b)
  964.   "Compare fileinfo A with fileinfo B and return t if A is `less'."
  965.  
  966.   (cond
  967.    ;; Sort acording to directories.
  968.    ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
  969.    ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)
  970.    ;; The DIRCHANGE entry is always first within the directory.
  971.    ((and (eq (cvs-fileinfo->type a) 'DIRCHANGE)
  972.      (not (eq (cvs-fileinfo->type b) 'DIRCHANGE))) t)
  973.    ((and (eq (cvs-fileinfo->type b) 'DIRCHANGE)
  974.      (not (eq (cvs-fileinfo->type a) 'DIRCHANGE))) nil)
  975.    ;; All files are sorted by file name.
  976.    ((string< (cvs-fileinfo->file-name a) (cvs-fileinfo->file-name b)))))
  977.  
  978. ;;----------
  979. (defun cvs-parse-error (stdout-buffer stderr-buffer err-buf pos &optional indicator)
  980.   "Handle a parse error when parsing the output from cvs.
  981. Args:  STDOUT-BUFFER STDERR-BUFFER ERR-BUF POS &optional INDICATOR.
  982.  
  983. ERR-BUF should be 'STDOUT or 'STDERR."
  984.  
  985.   (setq pos (1- pos))
  986.   (set-buffer cvs-buffer-name)
  987.   (setq buffer-read-only nil)
  988.   (erase-buffer)
  989.   (insert "To: " pcl-cvs-bugs-address "\n")
  990.   (insert "Subject: pcl-cvs release" pcl-cvs-version " parse error.\n")
  991.   (insert (concat mail-header-separator "\n"))
  992.   (insert "This bug report is automatically generated by pcl-cvs\n")
  993.   (insert "because it doesn't understand some output from CVS.  Below\n")
  994.   (insert "is detailed information about the error.  Please send\n")
  995.   (insert "this, together with any information you think might be\n")
  996.   (insert "useful for me to fix the bug, to the address above.  But\n")
  997.   (insert "please check the \"known problems\" section of the\n")
  998.   (insert "documentation first.  Note that this buffer contains\n")
  999.   (insert "information that you might consider confidential.  You\n")
  1000.   (insert "are encouraged to read through it before sending it.\n")
  1001.   (insert "\n")
  1002.   (insert "Press C-c C-c to send this email.\n\n")
  1003.   (insert "Please state the version of these programs you are using:\n\n")
  1004.   (insert "RCS:  \ndiff: \n\n")
  1005.  
  1006.   (let* ((stdout (save-excursion (set-buffer stdout-buffer) (buffer-string)))
  1007.      (stderr (save-excursion (set-buffer stderr-buffer) (buffer-string)))
  1008.      (errstr (if (eq err-buf 'STDOUT) stdout stderr))
  1009.      (errline-end (string-match "\n" errstr pos))
  1010.      (errline (substring errstr pos errline-end)))
  1011.     (insert (format "Offending line (%d chars): >" (- errline-end pos)))
  1012.     (insert errline)
  1013.     (insert "<\n")
  1014.     (insert "Sent to " (symbol-name err-buf) " at pos " (format "%d\n" pos))
  1015.     (if indicator
  1016.     (insert "Optional args: \"" indicator "\".\n"))
  1017.     (insert "\nEmacs-version: " (emacs-version) "\n")
  1018.     (insert "Pcl-cvs Version: "
  1019.         "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n")
  1020.     (insert "CVS Version: "
  1021.         "@(#)lisp/pcl-cvs:$Name:  $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $\n\n")
  1022.     (insert (format "--- Contents of stdout buffer (%d chars) ---\n"
  1023.             (length stdout)))
  1024.     (insert stdout)
  1025.     (insert "--- End of stdout buffer ---\n")
  1026.     (insert (format "--- Contents of stderr buffer (%d chars) ---\n"
  1027.             (length stderr)))
  1028.     (insert stderr)
  1029.     (insert "--- End of stderr buffer ---\n")
  1030.     (insert "\nEnd of bug report.\n")
  1031.     (require 'sendmail)
  1032.     (mail-mode)
  1033.     (error "CVS parse error - please report this bug.")))
  1034.       
  1035. ;;----------
  1036. (defun cvs-parse-update (stdout-buffer stderr-buffer)
  1037.   "Parse the output from `cvs update'.
  1038.  
  1039. Args:  STDOUT-BUFFER STDERR-BUFFER.
  1040.  
  1041. This functions parses the from `cvs update' (which should be
  1042. separated in its stdout- and stderr-components) and prints a
  1043. pretty representation of it in the *cvs* buffer.
  1044.  
  1045. Signals an error if unexpected output was detected in the buffer."
  1046.  
  1047.   (let* ((head (cons 'dummy nil))
  1048.      (tail (cvs-parse-stderr stdout-buffer stderr-buffer
  1049.                  head default-directory))
  1050.      (root-dir default-directory))
  1051.     (cvs-parse-stdout stdout-buffer stderr-buffer tail root-dir)
  1052.     (setq head (sort (cdr head) (function cvs-compare-fileinfos)))
  1053.     (collection-clear cvs-cookie-handle)
  1054.     (collection-append-cookies cvs-cookie-handle head)
  1055.     (cvs-remove-stdout-shadows)
  1056.     (if cvs-auto-remove-handled-directories
  1057.     (cvs-remove-empty-directories))
  1058.     (set-buffer cvs-buffer-name)
  1059.     (cvs-mode)
  1060.     ;; XEmacs - tedium should let you know when it's ended...
  1061.     (if (pos-visible-in-window-p (point-min))
  1062.     nil                             ; assume that the user will see it...
  1063.       (ding t 'ready)
  1064.       (message "CVS update is ready."))
  1065.     (goto-char (point-min))
  1066.     (tin-goto-previous cvs-cookie-handle (point-min) 1)
  1067.     (setq default-directory root-dir)))
  1068.  
  1069. ;;----------
  1070. (defun cvs-remove-stdout-shadows ()
  1071.   "Remove entries in the *cvs* buffer that comes from both stdout and stderr.
  1072. If there is two entries for a single file the second one should be
  1073. deleted.  (Remember that sort uses a stable sort algorithm, so one can
  1074. be sure that the stderr entry is always first)."
  1075.  
  1076.   (collection-filter-tins cvs-cookie-handle
  1077.               (function
  1078.                (lambda (tin)
  1079.                  (not (cvs-shadow-entry-p tin))))))
  1080.  
  1081. ;;----------
  1082. (defun cvs-shadow-entry-p (tin)
  1083.   "Return non-nil if TIN is a shadow entry.
  1084. Args:  TIN.
  1085.  
  1086. A TIN is a shadow entry if the previous tin contains the same file."
  1087.  
  1088.   (let* ((previous-tin (tin-previous cvs-cookie-handle tin))
  1089.      (curr (tin-cookie cvs-cookie-handle tin))
  1090.      (prev (and previous-tin
  1091.             (tin-cookie cvs-cookie-handle previous-tin))))
  1092.     (and
  1093.      prev curr
  1094.      (string= (cvs-fileinfo->file-name prev)
  1095.           (cvs-fileinfo->file-name curr))
  1096.      (string= (cvs-fileinfo->dir prev)
  1097.           (cvs-fileinfo->dir curr))
  1098.      (or
  1099.       (and (eq (cvs-fileinfo->type prev) 'CONFLICT)
  1100.        (eq (cvs-fileinfo->type curr) 'CONFLICT))
  1101.       (and (eq (cvs-fileinfo->type prev) 'MERGED)
  1102.        (eq (cvs-fileinfo->type curr) 'MODIFIED))
  1103.       (and (eq (cvs-fileinfo->type prev) 'REM-EXIST)
  1104.        (eq (cvs-fileinfo->type curr) 'REMOVED))))))
  1105.  
  1106. ;;----------
  1107. (defun cvs-find-backup-file (filename &optional dirname)
  1108.   "Look for a backup file for FILENAME, optionally in directory DIRNAME, and if
  1109. there is one, return the name of the first file found as a string."
  1110.  
  1111.   (if (eq dirname nil)
  1112.       (setq dirname default-directory))
  1113.   (car (directory-files dirname nil (concat "^\\" cvs-bakprefix filename
  1114.                         "\\."))))
  1115.  
  1116. ;;----------
  1117. (defun cvs-find-backup-revision (filename)
  1118.   "Take FILENAME as the name of a cvs backup file and return the revision of
  1119. that file as a string."
  1120.  
  1121.     (substring filename
  1122.            (+ 1 (string-match "\\.\\([0-9.]+\\)$" filename))))
  1123.  
  1124. ;;----------
  1125. (defun cvs-parse-stderr (stdout-buffer stderr-buffer head dir)
  1126.   "Parse the output from CVS that is written to stderr.
  1127. Args:  STDOUT-BUFFER STDERR-BUFFER HEAD DIR
  1128.  
  1129. STDOUT-BUFFER holds the output that cvs sent to stdout.  It is only
  1130. used to create a bug report in case there is a parse error.
  1131. STDERR-BUFFER is the buffer that holds the output to parse.
  1132. HEAD is a cons-cell, the head of the list that is built.
  1133. DIR is the directory the `cvs update' was run in.
  1134.  
  1135. This function returns the last cons-cell in the list that is built."
  1136.  
  1137.   (save-window-excursion
  1138.     (set-buffer stderr-buffer)
  1139.     (goto-char (point-min))
  1140.     (let ((current-dir dir)
  1141.       (root-dir dir))
  1142.  
  1143.       (while (< (point) (point-max))
  1144.     (cond
  1145.  
  1146.      ;; CVS is descending a subdirectory.
  1147.  
  1148.      ((looking-at
  1149.        "^cvs \\(server\\|update\\): Updating \\(.*\\)$")
  1150.       (setq current-dir
  1151.         (cvs-get-current-dir
  1152.          root-dir
  1153.          (buffer-substring (match-beginning 2) (match-end 2))))
  1154.       (setcdr head (list (cvs-create-fileinfo
  1155.                   'DIRCHANGE
  1156.                   current-dir
  1157.                   "."    ; the old version had nil here???
  1158.                   (buffer-substring (match-beginning 0)
  1159.                         (match-end 0)))))
  1160.       (setq head (cdr head))
  1161.       (forward-line 1))
  1162.  
  1163.      ;; File removed, since it is removed (by third party) in repository.
  1164.        
  1165.      ((or (looking-at
  1166.            "^cvs \\(update\\|server\\): warning: \\(.*\\) is not (any longer) pertinent")
  1167.           (looking-at
  1168.            "^cvs \\(update\\|server\\): \\(.*\\) is no longer in the repository"))
  1169.  
  1170.       (setcdr head (list (cvs-create-fileinfo
  1171.                   'CVS-REMOVED
  1172.                   current-dir
  1173.                   (file-name-nondirectory
  1174.                    (buffer-substring (match-beginning 2)
  1175.                          (match-end 2)))
  1176.                   (buffer-substring (match-beginning 0)
  1177.                         (match-end 0)))))
  1178.       (setq head (cdr head))
  1179.       (forward-line 1))
  1180.  
  1181.      ;; File removed by you, but recreated by cvs.  Ignored.  Will say
  1182.      ;; "Updated" on the next line.
  1183.  
  1184.      ((looking-at
  1185.        "^cvs \\(update\\|server\\): warning: .* was lost$")
  1186.       (forward-line 1))
  1187.  
  1188.      ;; File unknown for some reason.
  1189.      ;; FIXME:  is it really a good idea to add this as unknown here?
  1190.  
  1191.      ((looking-at
  1192.        "cvs \\(update\\|server\\): nothing known about \\(.*\\)$")
  1193.       (let ((filename (buffer-substring (match-beginning 2)
  1194.                         (match-end 2))))
  1195.         (if (file-directory-p filename)
  1196.         (setcdr head (list (cvs-create-fileinfo
  1197.                     'UNKNOWN-DIR
  1198.                     current-dir
  1199.                     "."
  1200.                     (buffer-substring (match-beginning 0)
  1201.                               (match-end 0)))))
  1202.           (setcdr head (list (cvs-create-fileinfo
  1203.                   'UNKNOWN
  1204.                   current-dir
  1205.                   (file-name-nondirectory filename)
  1206.                   (buffer-substring (match-beginning 0)
  1207.                             (match-end 0)))))))
  1208.       (setq head (cdr head))
  1209.       (forward-line 1))
  1210.  
  1211.      ;; A file that has been created by you, but added to the cvs
  1212.      ;; repository by another.
  1213.  
  1214.      ((looking-at
  1215.        "^cvs \\(update\\|server\\): move away \\(.*\\); it is in the way$")
  1216.       (setcdr head (list (cvs-create-fileinfo
  1217.                   'MOVE-AWAY
  1218.                   current-dir
  1219.                   (file-name-nondirectory
  1220.                    (buffer-substring (match-beginning 2)
  1221.                          (match-end 2)))
  1222.                   (buffer-substring (match-beginning 0)
  1223.                         (match-end 0)))))
  1224.       (setq head (cdr head))
  1225.       (forward-line 1))
  1226.  
  1227.      ;; Cvs waits for a lock.  Ignore.
  1228.  
  1229.      ((looking-at
  1230.        "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for .*lock in ")
  1231.       (forward-line 1))
  1232.      ((looking-at
  1233.        "^cvs \\(update\\|server\\): \\[..:..:..\\] obtained lock in ")
  1234.       (forward-line 1))
  1235.  
  1236.      ;; File removed in repository, but edited by you.
  1237.  
  1238.      ((looking-at
  1239.        "^cvs \\(update\\|server\\): conflict: \\(.*\\) is modified but no longer in the repository$")
  1240.       (setcdr head (list
  1241.             (cvs-create-fileinfo
  1242.              'REM-CONFLICT
  1243.              current-dir
  1244.              (file-name-nondirectory
  1245.               (buffer-substring (match-beginning 2)
  1246.                         (match-end 2)))
  1247.              (buffer-substring (match-beginning 0)
  1248.                        (match-end 0)))))
  1249.       (setq head (cdr head))
  1250.       (forward-line 1))
  1251.  
  1252.      ;; File removed in repository, but edited by someone else.
  1253.  
  1254.      ((looking-at
  1255.        "^cvs \\(update\\|server\\): conflict: removed \\(.*\\) was modified by second party")
  1256.       (setcdr head
  1257.           (list
  1258.            (cvs-create-fileinfo
  1259.             'MOD-CONFLICT
  1260.             current-dir
  1261.             (buffer-substring (match-beginning 1)
  1262.                       (match-end 1))
  1263.             (buffer-substring (match-beginning 0)
  1264.                       (match-end 0)))))
  1265.       (setq head (cdr head))
  1266.       (forward-line 1))
  1267.  
  1268.      ;; File removed in repository, but not in local directory.
  1269.  
  1270.      ((looking-at
  1271.        "^cvs \\(update\\|server\\): \\(.*\\) should be removed and is still there")
  1272.       (setcdr head
  1273.           (list
  1274.            (cvs-create-fileinfo
  1275.             'REM-EXIST
  1276.             current-dir
  1277.             (buffer-substring (match-beginning 2)
  1278.                       (match-end 2))
  1279.             (buffer-substring (match-beginning 0)
  1280.                       (match-end 0)))))
  1281.       (setq head (cdr head))
  1282.       (forward-line 1))
  1283.  
  1284.      ;; Error searching for repository
  1285.  
  1286.      ((looking-at
  1287.        "^cvs \\(update\\|server\\): in directory ")
  1288.       (let ((start (point)))
  1289.         (forward-line 1)
  1290.         (cvs-skip-line stdout-buffer stderr-buffer
  1291.                (regexp-quote "cvs [update aborted]: there is no repository "))
  1292.         (setcdr head (list (cvs-create-fileinfo
  1293.                 'REPOS-MISSING
  1294.                 current-dir
  1295.                 nil
  1296.                 (buffer-substring start (point)))))
  1297.         (setq head (cdr head))))
  1298.  
  1299.      ;; Silly warning from attempted conflict resolution.  Ignored.
  1300.      ;; FIXME:  Should it be?
  1301.      ;; eg.:  "cvs update: cannot find revision APC-web-update in file .cvsignore"
  1302.      ;;
  1303.      ((looking-at
  1304.        "^cvs \\(update\\|server\\): cannot find revision \\(.*\\) in file \\(.*\\)$")
  1305.       (forward-line 1)
  1306.       (message "%s" (buffer-substring (match-beginning 0) (match-end 0))))
  1307.  
  1308.      ;; CVS has decided to merge someone elses changes into this document.
  1309.      ;; About to start an rcsmerge operation...
  1310.      ;;
  1311.      ((looking-at
  1312.        "^RCS file: ")
  1313.  
  1314.       ;; skip the "RCS file:" line...
  1315.       (forward-line 1)
  1316.  
  1317.       (let ((complex-start (point))
  1318.         base-revision        ; the first revision retrieved to merge from
  1319.         head-revision        ; the second revision retrieved to merge from
  1320.         filename        ; the name of the file being merged
  1321.         backup-file        ; the name of the backup of the working file
  1322.         backup-revision)    ; the revision of the original working file
  1323.  
  1324.         (setq base-revision
  1325.           (cvs-skip-line stdout-buffer stderr-buffer
  1326.                  "^retrieving revision \\(.*\\)$"
  1327.                  1))
  1328.         (setq head-revision
  1329.           (cvs-skip-line stdout-buffer stderr-buffer
  1330.                  "^retrieving revision \\(.*\\)$"
  1331.                  1))
  1332.         (setq filename
  1333.           (cvs-skip-line stdout-buffer stderr-buffer
  1334.                  "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
  1335.                  1))
  1336.         (setq backup-file
  1337.           (cvs-find-backup-file filename current-dir))
  1338.         (setq backup-revision
  1339.           (cvs-find-backup-revision backup-file))
  1340.  
  1341.          ;; Was there a conflict during the merge?
  1342.  
  1343.         (cond
  1344.  
  1345.          ;;;; From CVS-1.3 & RCS-5.6.0.1 with GNU-Diffutils-2.5:
  1346.          ;;;; "cvs update -j OLD-REV -j NEW-REV ."
  1347.          ;;
  1348.          ;; RCS file: /big/web-CVS/apc/cmd/Main/logout.sh,v
  1349.          ;; retrieving revision 1.1.1.1
  1350.          ;; retrieving revision 1.1.1.2
  1351.          ;; Merging differences between 1.1.1.1 and 1.1.1.2 into logout.sh
  1352.          ;; rcsmerge warning: overlaps during merge
  1353.  
  1354.          ((looking-at
  1355.            ;; Allow both RCS 5.5 and 5.6.  (5.6 prints "rcs" and " warning").
  1356.            "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
  1357.  
  1358.           ;; Yes, this is a conflict.
  1359.           (cvs-skip-line stdout-buffer stderr-buffer
  1360.                  "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
  1361.  
  1362.           ;; this line doesn't seem to appear in all cases -- perhaps only
  1363.           ;; in "-j A -j B" usage, in which case this indicates ????
  1364.           (cvs-skip-line stdout-buffer stderr-buffer
  1365.                  "^cvs \\(update\\|server\\): conflicts found in ")
  1366.  
  1367.           (let ((fileinfo
  1368.              (cvs-create-fileinfo
  1369.               'CONFLICT current-dir
  1370.               filename
  1371.               (buffer-substring complex-start (point)))))
  1372.  
  1373.         ;; squirrel away info about the files that were retrieved for merging
  1374.         (cvs-set-fileinfo->base-revision fileinfo base-revision)
  1375.         (cvs-set-fileinfo->head-revision fileinfo head-revision)
  1376.         (cvs-set-fileinfo->backup-revision fileinfo backup-revision)
  1377.         (cvs-set-fileinfo->backup-file fileinfo backup-file)
  1378.  
  1379.         (setcdr head (list fileinfo))
  1380.         (setq head (cdr head))))
  1381.  
  1382.          ;; Was it a conflict, and was RCS compiled without DIFF3_BIN, in
  1383.          ;; which case this is a failed conflict resolution?
  1384.  
  1385.          ((looking-at
  1386.            ;; Allow both RCS 5.5 and 5.6.  (5.6 prints "rcs" and " warning").
  1387.            "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
  1388.  
  1389.           (cvs-skip-line stdout-buffer stderr-buffer
  1390.                  "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
  1391.           (cvs-skip-line stdout-buffer stderr-buffer
  1392.                  "^cvs update: could not merge ")
  1393.           (cvs-skip-line stdout-buffer stderr-buffer
  1394.                  "^cvs update: restoring .* from backup file ")
  1395.           (let ((fileinfo
  1396.              (cvs-create-fileinfo
  1397.               'CONFLICT current-dir
  1398.               filename
  1399.               (buffer-substring complex-start (point)))))
  1400.         (setcdr head (list fileinfo))
  1401.         (setq head (cdr head))))       
  1402.  
  1403.          ;; Not a conflict; it must be a succesful merge.
  1404.  
  1405.          (t
  1406.           (let ((fileinfo
  1407.              (cvs-create-fileinfo
  1408.               'MERGED current-dir
  1409.               filename
  1410.               (buffer-substring complex-start (point)))))
  1411.         (cvs-set-fileinfo->base-revision fileinfo base-revision)
  1412.         (cvs-set-fileinfo->head-revision fileinfo head-revision)
  1413.         (cvs-set-fileinfo->backup-revision fileinfo backup-revision)
  1414.         (cvs-set-fileinfo->backup-file fileinfo backup-file)
  1415.         (setcdr head (list fileinfo))
  1416.         (setq head (cdr head)))))))
  1417.  
  1418.          ;; Patch failure message with CVS client.
  1419.          ;; Ignore, since a failed patch implies that the file proper
  1420.          ;; subsequently will be fetched from the server.
  1421.      ((looking-at
  1422.        "^[0-9]+ out of [0-9]+ hunks failed--saving rejects to ")
  1423.       (forward-line 1))
  1424.  
  1425.      ;; Error messages from CVS (incomplete)
  1426.  
  1427.      ((looking-at
  1428.        "^cvs \\(update\\|server\\): \\(invalid option .*\\)$")
  1429.       (error "Interface problem with CVS: %s"
  1430.          (buffer-substring (match-beginning 2) (match-end 2))))
  1431.  
  1432.      ;; network errors
  1433.  
  1434.      ;; Kerberos connection attempted but failed.  This is not
  1435.          ;; really an error, as CVS will automatically fall back to
  1436.          ;; rsh.  Plus it tries kerberos, if available, even when rsh
  1437.          ;; is what you really wanted.
  1438.  
  1439.      ((looking-at
  1440.        "^cvs update: kerberos connect:.*$")
  1441.       (forward-line 1)
  1442.       (message "Remote CVS: %s"
  1443.            (buffer-substring (match-beginning 0) (match-end 0))))
  1444.  
  1445.          ;; And when kerberos *does* fail, cvs prints out some stuff
  1446.          ;; as it tries rsh.  Ignore that stuff too.
  1447.  
  1448.      ((looking-at
  1449.        "^cvs update: trying to start server using rsh$")
  1450.       (forward-line 1))
  1451.  
  1452.      ((looking-at
  1453.        "^\\([^:]*\\) Connection timed out")
  1454.       (error "Remote CVS: %s"
  1455.            (buffer-substring (match-beginning 0) (match-end 0))))
  1456.  
  1457.      ((looking-at
  1458.        "^Permission denied.")
  1459.       (error "Remote CVS: %s"
  1460.          (buffer-substring (match-beginning 0) (match-end 0))))
  1461.  
  1462.      ((looking-at
  1463.        "^cvs \\[update aborted\\]: premature end of file from server")
  1464.       (error "Remote CVS: %s"
  1465.          (buffer-substring (match-beginning 0) (match-end 0))))
  1466.  
  1467.      ;; Empty line.  Probably inserted by mistake by user (or developer :-)
  1468.      ;; Ignore.
  1469.  
  1470.      ((looking-at
  1471.        "^$")
  1472.       (forward-line 1))
  1473.  
  1474.      ((looking-at
  1475.        "^Executing ssh-askpass to query the password")
  1476.       (forward-line 1))
  1477.  
  1478.      ;; top-level parser (cond) default clause
  1479.  
  1480.      (t
  1481.       (cvs-skip-line stdout-buffer stderr-buffer
  1482.              "^UN-MATCHABLE-OUTPUT"))))))
  1483.  
  1484.   ;; cause this function to return the head of the parser output list
  1485.   head)
  1486.  
  1487. ;;----------
  1488. (defun cvs-parse-stdout (stdout-buffer stderr-buffer head root-dir)
  1489.   "Parse the output from CVS that is written to stderr.
  1490. Args:  STDOUT-BUFFER STDERR-BUFFER HEAD ROOT-DIR
  1491.  
  1492. STDOUT-BUFFER is the buffer that holds the output to parse.
  1493. STDERR-BUFFER holds the output that cvs sent to stderr.  It is only
  1494. used to create a bug report in case there is a parse error.
  1495.  
  1496. HEAD is a cons-cell, the head of the list that is built.
  1497. ROOT-DIR is the directory the `cvs update' was run in.
  1498.  
  1499. This function doesn't return anything particular."
  1500.  
  1501.   (save-window-excursion
  1502.     (set-buffer stdout-buffer)
  1503.     (goto-char (point-min))
  1504.     (while (< (point) (point-max))
  1505.       (cond
  1506.  
  1507.        ;; M:  The file is modified by the user, and untouched in the repository.
  1508.        ;; A:  The file is "cvs add"ed, but not "cvs ci"ed.
  1509.        ;; R:  The file is "cvs remove"ed, but not "cvs ci"ed.
  1510.        ;; C:  Conflict (only useful if a join was done and stderr has info...)
  1511.        ;; U:  The file is copied from the repository.
  1512.        ;; ?:  Unknown file or directory.
  1513.  
  1514.        ((looking-at
  1515.      "^\\([MARCUP?]\\) \\(.*\\)$")
  1516.     (let*
  1517.         ((c (char-after (match-beginning 1)))
  1518.          (full-path (concat (file-name-as-directory root-dir)
  1519.                 (buffer-substring (match-beginning 2)
  1520.                           (match-end 2))))
  1521.          (isdir (file-directory-p full-path))
  1522.          (fileinfo (cvs-create-fileinfo
  1523.             (cond ((eq c ?M) 'MODIFIED)
  1524.                   ((eq c ?A) 'ADDED)
  1525.                   ((eq c ?R) 'REMOVED)
  1526.                   ((eq c ?C) 'CONFLICT)
  1527.                   ((eq c ?U) 'UPDATED)
  1528.                   ((eq c ?P) 'PATCHED)
  1529.                   ((eq c ??) (if isdir
  1530.                          'UNKNOWN-DIR
  1531.                        'UNKNOWN)))
  1532.             (substring (file-name-directory full-path) 0 -1)
  1533.             (file-name-nondirectory full-path)
  1534.             (buffer-substring (match-beginning 0) (match-end 0)))))
  1535.       ;; Updated and Patched files require no further action.
  1536.       (if (memq c '(?U ?P))
  1537.           (cvs-set-fileinfo->handled fileinfo t))
  1538.  
  1539.       ;; Link this last on the list.
  1540.       (setcdr head (list fileinfo))
  1541.       (setq head (cdr head))
  1542.       (forward-line 1)))
  1543.  
  1544.        ;; Executing a program because of the -u option in modules.
  1545.        ((looking-at
  1546.      "^cvs \\(update\\|server\\): Executing")
  1547.     ;; Skip by any output the program may generate to stdout.
  1548.     ;; Note that pcl-cvs will get seriously confused if the
  1549.     ;; program prints anything to stderr.
  1550.     (re-search-forward cvs-update-prog-output-skip-regexp)
  1551.     (forward-line 1))
  1552.  
  1553.        ;; Patch informational message with CVS client.
  1554.        ;; Ignore, since this simply tells us that the patch in question
  1555.        ;; already has been applied to the file.
  1556.        ((looking-at
  1557.      "^.* already contains the differences between .* and ")
  1558.         (forward-line 1))
  1559.  
  1560.        (t
  1561.     (cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point)
  1562.              "cvs-parse-stdout"))))))
  1563.  
  1564. ;;----------
  1565. (defun cvs-pp (fileinfo)
  1566.   "Pretty print FILEINFO.  Insert a printed representation in current buffer.
  1567. For use by the cookie package."
  1568.  
  1569.   (let ((a (cvs-fileinfo->type fileinfo))
  1570.         (s (if (cvs-fileinfo->marked fileinfo)
  1571.                "*" " "))
  1572.         (f (cvs-fileinfo->file-name fileinfo))
  1573.         (ci (if (cvs-fileinfo->handled fileinfo)
  1574.                 "  " "ci")))
  1575.     (insert
  1576.      (cond
  1577.       ((eq a 'UPDATED)
  1578.        (format "%s Updated     %s" s f))
  1579.       ((eq a 'PATCHED)
  1580.        (format "%s Patched     %s" s f))
  1581.       ((eq a 'MODIFIED)
  1582.        (format "%s Modified %s %s" s ci f))
  1583.       ((eq a 'MERGED)
  1584.        (format "%s Merged   %s %s" s ci f))
  1585.       ((eq a 'CONFLICT)
  1586.        (format "%s Conflict    %s" s f))
  1587.       ((eq a 'ADDED)
  1588.        (format "%s Added    %s %s" s ci f))
  1589.       ((eq a 'REMOVED)
  1590.        (format "%s Removed  %s %s" s ci f))
  1591.       ((eq a 'UNKNOWN)
  1592.        (format "%s Unknown     %s" s f))
  1593.       ((eq a 'UNKNOWN-DIR)
  1594.        (format "%s Unknown dir %s" s f))
  1595.       ((eq a 'CVS-REMOVED)
  1596.        (format "%s Removed from repository:  %s" s f))
  1597.       ((eq a 'REM-CONFLICT)
  1598.        (format "%s Conflict: Removed from repository, changed by you: %s" s f))
  1599.       ((eq a 'MOD-CONFLICT)
  1600.        (format "%s Conflict: Removed by you, changed in repository: %s" s f))
  1601.       ((eq a 'REM-EXIST)
  1602.        (format "%s Conflict: Removed by you, but still exists: %s" s f))
  1603.       ((eq a 'DIRCHANGE)
  1604.        (format "\nIn directory %s:" (cvs-fileinfo->dir fileinfo)))
  1605.       ((eq a 'MOVE-AWAY)
  1606.        (format "%s Move away %s - it is in the way" s f))
  1607.       ((eq a 'REPOS-MISSING)
  1608.        (format "  This repository directory is missing!  Remove this directory manually."))
  1609.       ((eq a 'MESSAGE)
  1610.        (cvs-fileinfo->full-log fileinfo))
  1611.       (t
  1612.        (format "%s Internal error!  %s" s f))))))
  1613.  
  1614.  
  1615. ;;; You can define your own keymap in .emacs.  pcl-cvs.el won't overwrite it.
  1616.  
  1617. (if cvs-mode-map
  1618.     nil
  1619.   (setq cvs-mode-map (make-keymap))
  1620.   (suppress-keymap cvs-mode-map)
  1621.   (define-prefix-command 'cvs-mode-map-control-c-prefix)
  1622.   (define-key cvs-mode-map "\C-?"    'cvs-mode-unmark-up)
  1623.   (define-key cvs-mode-map "\C-k"    'cvs-mode-acknowledge)
  1624.   (define-key cvs-mode-map "\C-n"    'cvs-mode-next-line)
  1625.   (define-key cvs-mode-map "\C-p"    'cvs-mode-previous-line)
  1626.   ;; ^C- keys are used to set various flags to control CVS features
  1627.   (define-key cvs-mode-map "\C-c"    'cvs-mode-map-control-c-prefix)
  1628.   (define-key cvs-mode-map "\C-c\C-c"    'cvs-change-cvsroot)
  1629.   (define-key cvs-mode-map "\C-c\C-d"    'cvs-set-diff-flags)
  1630.   (define-key cvs-mode-map "\C-c\C-l"    'cvs-set-log-flags)
  1631.   (define-key cvs-mode-map "\C-c\C-s"    'cvs-set-status-flags)
  1632.   (define-key cvs-mode-map "\C-c\C-u"    'cvs-set-update-optional-flags)
  1633.   ;; M- keys are usually those that operate on modules
  1634.   (define-key cvs-mode-map "\M-\C-?"    'cvs-mode-unmark-all-files)
  1635.   (define-key cvs-mode-map "\M-C"    'cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
  1636.   (define-key cvs-mode-map "\M-a"    'cvs-mode-admin)
  1637.   (define-key cvs-mode-map "\M-c"    'cvs-mode-checkout)
  1638.   (define-key cvs-mode-map "\M-o"    'cvs-mode-checkout-other-window)
  1639.   (define-key cvs-mode-map "\M-p"    'cvs-mode-rdiff) ; i.e. "create a Patch"
  1640.   (define-key cvs-mode-map "\M-r"    'cvs-mode-release)
  1641.   (define-key cvs-mode-map "\M-t"    'cvs-mode-rtag)
  1642.   ;; keys that operate on files
  1643.   (define-key cvs-mode-map " "    'cvs-mode-next-line)
  1644.   (define-key cvs-mode-map "?"    'describe-mode)
  1645.   (define-key cvs-mode-map "A"    'cvs-mode-add-change-log-entry-other-window)
  1646.   (define-key cvs-mode-map "B"    'cvs-mode-byte-compile-files)
  1647.   (define-key cvs-mode-map "C"  'cvs-mode-changelog-commit)
  1648.   (define-key cvs-mode-map "E"    'cvs-mode-emerge)
  1649.   (define-key cvs-mode-map "G"    'cvs-update)
  1650.   (define-key cvs-mode-map "M"    'cvs-mode-mark-all-files)
  1651.   (define-key cvs-mode-map "Q"    'cvs-examine)
  1652.   (define-key cvs-mode-map "R"    'cvs-mode-revert-updated-buffers)
  1653.   (define-key cvs-mode-map "U"    'cvs-mode-undo-local-changes)
  1654.   (define-key cvs-mode-map "a"    'cvs-mode-add)
  1655.   (define-key cvs-mode-map "b"    'cvs-mode-diff-backup)
  1656.   (define-key cvs-mode-map "c"    'cvs-mode-commit)
  1657.   (define-key cvs-mode-map "d"    'cvs-mode-diff-cvs)
  1658.   (define-key cvs-mode-map "e"    'cvs-mode-ediff)
  1659.   (define-key cvs-mode-map "f"    'cvs-mode-find-file)
  1660.   (define-key cvs-mode-map "g"    'cvs-mode-update-no-prompt)
  1661.   (define-key cvs-mode-map "h"    'cvs-mode-diff-head)
  1662.   (define-key cvs-mode-map "i"    'cvs-mode-ignore)
  1663.   (define-key cvs-mode-map "l"    'cvs-mode-log)
  1664.   (define-key cvs-mode-map "m"    'cvs-mode-mark)
  1665.   (define-key cvs-mode-map "n"    'cvs-mode-next-line)
  1666.   (define-key cvs-mode-map "o"    'cvs-mode-find-file-other-window)
  1667.   (define-key cvs-mode-map "p"    'cvs-mode-previous-line)
  1668.   (define-key cvs-mode-map "q"    'bury-buffer)
  1669.   (define-key cvs-mode-map "r"    'cvs-mode-remove-file)
  1670.   (define-key cvs-mode-map "s"    'cvs-mode-status)
  1671.   (define-key cvs-mode-map "t"    'cvs-mode-tag)
  1672.   (define-key cvs-mode-map "u"    'cvs-mode-unmark)
  1673.   (define-key cvs-mode-map "v"    'cvs-mode-diff-vendor)
  1674.   (define-key cvs-mode-map "x"    'cvs-mode-remove-handled))
  1675.  
  1676. ;;----------
  1677. (defun cvs-get-marked (&optional ignore-marks ignore-contents)
  1678.   "Return a list of all selected tins.
  1679. Args:  &optional IGNORE-MARKS IGNORE-CONTENTS.
  1680.  
  1681. If there are any marked tins, and IGNORE-MARKS is nil, return them.  Otherwise,
  1682. if the cursor selects a directory, return all files in it, unless there are
  1683. none, in which case just return the directory; or unless IGNORE-CONTENTS is not
  1684. nil, in which case also just return the directory.  Otherwise return (a list
  1685. containing) the file the cursor points to, or an empty list if it doesn't point
  1686. to a file at all."
  1687.  
  1688.   (cond
  1689.    ;; Any marked cookies?
  1690.    ((and (not ignore-marks)
  1691.      (collection-collect-tin cvs-cookie-handle 'cvs-fileinfo->marked)))
  1692.    ;; Nope.
  1693.    ((and (not ignore-contents)
  1694.      (let ((sel (tin-locate cvs-cookie-handle (point))))
  1695.        (cond
  1696.         ;; If a directory is selected, all it members are returned.
  1697.         ((and sel (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle
  1698.                               sel))
  1699.               'DIRCHANGE))
  1700.          (let ((retsel
  1701.             (collection-collect-tin cvs-cookie-handle
  1702.                         'cvs-dir-member-p
  1703.                         (cvs-fileinfo->dir (tin-cookie
  1704.                                 cvs-cookie-handle sel)))))
  1705.            (if retsel
  1706.            retsel
  1707.          (list sel))))
  1708.         (t
  1709.          (list sel))))))
  1710.    (t
  1711.     (list (tin-locate cvs-cookie-handle (point))))))
  1712.  
  1713. ;;----------
  1714. (defun cvs-dir-member-p (fileinfo dir)
  1715.   "Return true if FILEINFO represents a file in directory DIR."
  1716.  
  1717.   (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
  1718.        (string= (cvs-fileinfo->dir fileinfo) dir)))
  1719.  
  1720. ;;----------
  1721. (defun cvs-dir-empty-p (tin)
  1722.   "Return non-nil if TIN is a directory that is empty.
  1723. Args:  CVS-BUF TIN."
  1724.  
  1725.   (and (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin)) 'DIRCHANGE)
  1726.        (or (not (tin-next cvs-cookie-handle tin))
  1727.        (eq (cvs-fileinfo->type
  1728.         (tin-cookie cvs-cookie-handle
  1729.                     (tin-next cvs-cookie-handle tin)))
  1730.            'DIRCHANGE))))
  1731.  
  1732. ;;----------
  1733. (defun cvs-mode-revert-updated-buffers ()
  1734.   "Revert any buffers that are UPDATED, PATCHED, MERGED or CONFLICT."
  1735.  
  1736.   (interactive)
  1737.   (cookie-map (function cvs-revert-fileinfo) cvs-cookie-handle))
  1738.  
  1739. ;;----------
  1740. (defun cvs-revert-fileinfo (fileinfo)
  1741.   "Revert the buffer that holds the file in FILEINFO if it has changed,
  1742. and if the type is UPDATED, PATCHED, MERGED or CONFLICT."
  1743.  
  1744.   (let* ((type (cvs-fileinfo->type fileinfo))
  1745.      (file (cvs-fileinfo->full-path fileinfo))
  1746.      (buffer (get-file-buffer file)))
  1747.     ;; For a revert to happen...
  1748.     (cond
  1749.      ((and
  1750.        ;; ...the type must be one that justifies a revert...
  1751.        (or (eq type 'UPDATED)
  1752.        (eq type 'PATCHED)
  1753.        (eq type 'MERGED)
  1754.        (eq type 'CONFLICT))
  1755.        ;; ...and the user must be editing the file...
  1756.        buffer)
  1757.       (save-excursion
  1758.     (set-buffer buffer)
  1759.     (cond
  1760.      ((buffer-modified-p)
  1761.       (error "%s: edited since last cvs-update."
  1762.          (buffer-file-name)))
  1763.      ;; Go ahead and revert the file.
  1764.      (t (revert-buffer 'dont-use-auto-save-file 'dont-ask))))))))
  1765.  
  1766. ;;----------
  1767. (defun cvs-mode-remove-handled ()
  1768.   "Remove all lines that are handled.
  1769. Empty directories are removed."
  1770.  
  1771.   (interactive)
  1772.   ;; Pass one:  remove files that are handled.
  1773.   (collection-filter-cookies cvs-cookie-handle
  1774.                  (function
  1775.                   (lambda (fileinfo)
  1776.                 (not (cvs-fileinfo->handled fileinfo)))))
  1777.   ;; Pass two:  remove empty directories.
  1778.   (if cvs-auto-remove-handled-directories
  1779.       (cvs-remove-empty-directories)))
  1780.  
  1781. ;;----------
  1782. (defun cvs-remove-empty-directories ()
  1783.   "Remove empty directories in the *cvs* buffer."
  1784.  
  1785.   (collection-filter-tins cvs-cookie-handle
  1786.               (function
  1787.                (lambda (tin)
  1788.                  (not (cvs-dir-empty-p tin))))))
  1789.  
  1790. ;;----------
  1791. (defun cvs-mode-mark (pos)
  1792.   "Mark a fileinfo.
  1793. Args:  POS.
  1794.  
  1795. If the fileinfo is a directory, all the contents of that directory are marked
  1796. instead.  A directory can never be marked.  POS is a buffer position."
  1797.  
  1798.   (interactive "d")
  1799.   (let* ((tin (tin-locate cvs-cookie-handle pos))
  1800.      (sel (tin-cookie cvs-cookie-handle tin)))
  1801.     (cond
  1802.      ;; Does POS point to a directory?  If so, mark all files in that directory.
  1803.      ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
  1804.       (cookie-map
  1805.        (function (lambda (f dir)
  1806.            (cond
  1807.             ((cvs-dir-member-p f dir)
  1808.              (cvs-set-fileinfo->marked f t)
  1809.              t))))        ; Tell cookie to redisplay this cookie.
  1810.        cvs-cookie-handle
  1811.        (cvs-fileinfo->dir sel)))
  1812.      (t
  1813.       (cvs-set-fileinfo->marked sel t)
  1814.       (tin-invalidate cvs-cookie-handle tin)
  1815.       (tin-goto-next cvs-cookie-handle pos 1)))))
  1816.   
  1817. ;;----------
  1818. (defun cvs-committable (tin)
  1819.   "Check if the TIN is committable.
  1820. It is committable if it
  1821.    a) is not handled and
  1822.    b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT."
  1823.  
  1824.   (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  1825.      (type (cvs-fileinfo->type fileinfo)))
  1826.     (and (not (cvs-fileinfo->handled fileinfo))
  1827.      (or (eq type 'MODIFIED)
  1828.          (eq type 'ADDED)
  1829.          (eq type 'REMOVED)
  1830.          (eq type 'MERGED)
  1831.          (eq type 'CONFLICT)))))
  1832.  
  1833. ;;----------
  1834. (defun cvs-mode-commit ()
  1835.   "Check in all marked files, or the current file.
  1836. The user will be asked for a log message in a buffer.
  1837. If cvs-erase-input-buffer is non-nil that buffer will be erased.
  1838. Otherwise mark and point will be set around the entire contents of the
  1839. buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
  1840.  
  1841.   (interactive)
  1842.   (let* ((cvs-buf (current-buffer))
  1843.      (marked (cvs-filter (function cvs-committable)
  1844.                  (cvs-get-marked))))
  1845.     (if (null marked)
  1846.     (error "Nothing to commit!")
  1847.       (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
  1848.       (goto-char (point-min))
  1849.  
  1850.       (if cvs-erase-input-buffer
  1851.       (erase-buffer)
  1852.     (push-mark (point-max)))
  1853.       (cvs-edit-mode)
  1854.       (make-local-variable 'cvs-commit-list)
  1855.       (setq cvs-commit-list marked)
  1856.       (message "Press C-c C-c when you are done editing."))))
  1857.  
  1858. ;;----------
  1859. (defun cvs-edit-done ()
  1860.   "Commit the files to the repository."
  1861.  
  1862.   (interactive)
  1863.   (if (null cvs-commit-list)
  1864.       (error "You have already committed the files"))
  1865.   (if (and (> (point-max) 1)
  1866.        (/= (char-after (1- (point-max))) ?\n)
  1867.        (or (eq cvs-commit-buffer-require-final-newline t)
  1868.            (and cvs-commit-buffer-require-final-newline
  1869.             (yes-or-no-p
  1870.              (format "Buffer %s does not end in newline.  Add one? "
  1871.                  (buffer-name))))))
  1872.       (save-excursion
  1873.     (goto-char (point-max))
  1874.     (insert ?\n)))
  1875.   (save-some-buffers)
  1876.   (let ((cc-list cvs-commit-list)
  1877.     (cc-buffer (get-buffer cvs-buffer-name))
  1878.     (msg-buffer (current-buffer))
  1879.     (msg (buffer-substring (point-min) (point-max))))
  1880.     (pop-to-buffer cc-buffer)
  1881.     (bury-buffer msg-buffer)
  1882.     (cvs-use-temp-buffer)
  1883.     (message "Committing...")
  1884.     (if (cvs-execute-list cc-list cvs-program
  1885.               (if cvs-cvsroot
  1886.                   (list "-d" cvs-cvsroot "commit" "-m" msg)
  1887.                 (list "commit" "-m" msg))
  1888.               "Committing %s...")
  1889.     (error "Something went wrong.  Check the %s buffer carefully."
  1890.            cvs-temp-buffer-name))
  1891.     ;; FIXME: don't do any of this if the commit fails.
  1892.     (let ((ccl cc-list))
  1893.       (while ccl
  1894.     (cvs-after-commit-function (tin-cookie cvs-cookie-handle (car ccl)))
  1895.     (setq ccl (cdr ccl))))
  1896.     (apply 'tin-invalidate cvs-cookie-handle cc-list)
  1897.     (set-buffer msg-buffer)
  1898.     (setq cvs-commit-list nil)
  1899.     (set-buffer cc-buffer)
  1900.     (if cvs-auto-remove-handled
  1901.     (cvs-mode-remove-handled)))
  1902.   
  1903.   (message "Committing... Done."))
  1904.  
  1905. ;;----------
  1906. (defun cvs-after-commit-function (fileinfo)
  1907.   "Do everything that needs to be done when FILEINFO has been committed.
  1908. The fileinfo->handle is set, and if the buffer is present it is reverted."
  1909.  
  1910.   (cvs-set-fileinfo->handled fileinfo t)
  1911.   (if cvs-auto-revert-after-commit
  1912.       (let* ((file (cvs-fileinfo->full-path fileinfo))
  1913.          (buffer (get-file-buffer file)))
  1914.     ;; For a revert to happen...
  1915.     (if buffer
  1916.         ;; ...the user must be editing the file...
  1917.         (save-excursion
  1918.           (set-buffer buffer)
  1919.           (if (not (buffer-modified-p))
  1920.           ;; ...but it must be unmodified.
  1921.           (revert-buffer 'dont-use-auto-save-file 'dont-ask)))))))
  1922.  
  1923. ;;----------
  1924. (defun cvs-execute-list (tin-list program constant-args &optional message-fmt)
  1925.   "Run PROGRAM on all elements on TIN-LIST.
  1926. Args:  TIN-LIST PROGRAM CONSTANT-ARGS.
  1927.  
  1928. The PROGRAM will be called with pwd set to the directory the files reside
  1929. in.  CONSTANT-ARGS should be a list of strings.  The arguments given to the
  1930. program will be CONSTANT-ARGS followed by all the files (from TIN-LIST) that
  1931. resides in that directory.  If the files in TIN-LIST resides in different
  1932. directories the PROGRAM will be run once for each directory (if all files in
  1933. the same directory appears after each other).
  1934.  
  1935. Any output from PROGRAM will be inserted in the current buffer.
  1936.  
  1937. This function return nil if all went well, or the numerical exit status or a
  1938. signal name as a string.  Note that PROGRAM might be called several times.  This
  1939. will return non-nil if something goes wrong, but there is no way to know which
  1940. process that failed.
  1941.  
  1942. If MESSAGE-FMT is not nil, then message is called to display progress with
  1943. MESSAGE-FMT as the string.  MESSAGE-FMT should contain one %s for the arg-list
  1944. being passed to PROGRAM."
  1945.  
  1946.   ;; FIXME:  something seems wrong with the error checking here....
  1947.  
  1948.   (let ((exitstatus nil))
  1949.     (while tin-list
  1950.       (let ((current-dir (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
  1951.                             (car tin-list))))
  1952.         arg-list
  1953.         arg-str)
  1954.  
  1955.     ;; Collect all marked files in this directory.
  1956.  
  1957.     (while (and tin-list
  1958.             (string= current-dir
  1959.                  (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
  1960.                                 (car tin-list)))))
  1961.       (setq arg-list
  1962.         (cons (cvs-fileinfo->file-name
  1963.                (tin-cookie cvs-cookie-handle (car tin-list)))
  1964.               arg-list))
  1965.       (setq tin-list (cdr tin-list)))
  1966.  
  1967.     (setq arg-list (nreverse arg-list))
  1968.  
  1969.     ;; Execute the command on all the files that were collected.
  1970.  
  1971.     (if message-fmt
  1972.         (message message-fmt
  1973.              (mapconcat 'cvs-quote-multiword-string
  1974.                 arg-list
  1975.                 " ")))
  1976.     (setq default-directory (file-name-as-directory current-dir))
  1977.     (insert (format "=== cd %s\n" default-directory))
  1978.     (insert (format "=== %s %s\n\n"
  1979.             program
  1980.             (mapconcat 'cvs-quote-multiword-string
  1981.                    (nconc (copy-sequence constant-args)
  1982.                       arg-list)
  1983.                    " ")))
  1984.     (let ((res (apply 'call-process program nil t t
  1985.               (nconc (copy-sequence constant-args) arg-list))))
  1986.       ;; Remember the first, or highest, exitstatus.
  1987.       (if (and (not (and (integerp res) (zerop res)))
  1988.            (or (null exitstatus)
  1989.                (and (integerp exitstatus) (= 1 exitstatus))))
  1990.           (setq exitstatus res)))
  1991.     (goto-char (point-max))
  1992.     (if message-fmt
  1993.         (message message-fmt
  1994.              (mapconcat 'cvs-quote-multiword-string
  1995.                 (nconc (copy-sequence arg-list) '("Done."))
  1996.                 " ")))
  1997.     exitstatus))))
  1998.  
  1999. ;;----------
  2000. ;;;; +++ not currently used!
  2001. (defun cvs-execute-single-file-list (tin-list extractor program constant-args
  2002.                           &optional cleanup message-fmt)
  2003.   "Run PROGRAM on all elements on TIN-LIST.
  2004. Args:  TIN-LIST EXTRACTOR PROGRAM CONSTANT-ARGS &optional CLEANUP.
  2005.  
  2006. The PROGRAM will be called with pwd set to the directory the files
  2007. reside in.  CONSTANT-ARGS is a list of strings to pass as arguments to
  2008. PROGRAM.  The arguments given to the program will be CONSTANT-ARGS
  2009. followed by the list that EXTRACTOR returns.
  2010.  
  2011. EXTRACTOR will be called once for each file on TIN-LIST.  It is given
  2012. one argument, the cvs-fileinfo.  It can return t, which means ignore
  2013. this file, or a list of arguments to send to the program.
  2014.  
  2015. If CLEANUP is not nil, the filenames returned by EXTRACTOR are deleted.
  2016.  
  2017. If MESSAGE-FMT is not nil, then message is called to display progress with
  2018. MESSAGE-FMT as the string.  MESSAGE-FMT should contain one %s for the arg-list
  2019. being passed to PROGRAM."
  2020.  
  2021.     (while tin-list
  2022.       (let ((current-dir (file-name-as-directory
  2023.               (cvs-fileinfo->dir
  2024.                (tin-cookie cvs-cookie-handle
  2025.                        (car tin-list)))))
  2026.         (arg-list
  2027.          (funcall extractor
  2028.               (tin-cookie cvs-cookie-handle (car tin-list)))))
  2029.  
  2030.     ;; Execute the command unless extractor returned t.
  2031.  
  2032.     (if (eq arg-list t)
  2033.         nil
  2034.       (setq default-directory current-dir)
  2035.       (insert (format "=== cd %s\n" default-directory))
  2036.       (insert (format "=== %s %s\n\n"
  2037.               program
  2038.               (mapconcat 'cvs-quote-multiword-string
  2039.                      (nconc (copy-sequence constant-args)
  2040.                         arg-list)
  2041.                      " ")))
  2042.       (if message-fmt
  2043.           (message message-fmt (mapconcat 'cvs-quote-multiword-string
  2044.                           arg-list
  2045.                           " ")))
  2046.       (apply 'call-process program nil t t
  2047.          (nconc (copy-sequence constant-args) arg-list))
  2048.       (goto-char (point-max))
  2049.       (if message-fmt
  2050.           (message message-fmt (mapconcat 'cvs-quote-multiword-string
  2051.                           (nconc arg-list '("Done."))
  2052.                           " ")))
  2053.       (if cleanup
  2054.           (while arg-list
  2055. ;;;;        (kill-buffer ?????)
  2056.         (delete-file (car arg-list))
  2057.         (setq arg-list (cdr arg-list))))))
  2058.       (setq tin-list (cdr tin-list))))
  2059.  
  2060. ;;----------
  2061. (defun cvs-edit-mode ()
  2062.   "\\<cvs-edit-mode-map>Mode for editing cvs log messages.
  2063. Commands:
  2064. \\[cvs-edit-done] checks in the file when you are ready.
  2065. This mode is based on fundamental mode."
  2066.  
  2067.   (interactive)
  2068.   (use-local-map cvs-edit-mode-map)
  2069.   (setq major-mode 'cvs-edit-mode)
  2070.   (setq mode-name "CVS Log")
  2071.   (auto-fill-mode 1))
  2072.  
  2073. ;;----------
  2074. (if cvs-edit-mode-map
  2075.     nil
  2076.   (setq cvs-edit-mode-map (make-sparse-keymap))
  2077.   (define-prefix-command 'cvs-edit-mode-control-c-prefix)
  2078.   (define-key cvs-edit-mode-map "\C-c" 'cvs-edit-mode-control-c-prefix)
  2079.   (define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done))
  2080.  
  2081. ;;----------
  2082. (defun cvs-diffable (tins)
  2083.   "Return a list of all tins on TINS that it makes sense to run
  2084. ``cvs diff'' on."
  2085.  
  2086.   ;; +++ There is an unnecessary (nreverse) here.  Get the list the
  2087.   ;; other way around instead!
  2088.   (let ((result nil))
  2089.     (while tins
  2090.       (let ((type (cvs-fileinfo->type
  2091.            (tin-cookie cvs-cookie-handle (car tins)))))
  2092.     (if (or (eq type 'MODIFIED)
  2093.         (eq type 'UPDATED)
  2094.         (eq type 'PATCHED)
  2095.         (eq type 'MERGED)
  2096.         (eq type 'CONFLICT)
  2097.         (eq type 'REMOVED)    ;+++Does this line make sense?
  2098.         (eq type 'ADDED))    ;+++Does this line make sense?
  2099.         (setq result (cons (car tins) result)))
  2100.     (setq tins (cdr tins))))
  2101.     (nreverse result)))
  2102.       
  2103. ;;----------
  2104. (defun cvs-mode-diff-cvs (&optional ignore-marks)
  2105.   "Diff the selected files against the base revisions in the repository.
  2106.  
  2107. If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
  2108. considered to be selected.  An optional prefix argument will invert the
  2109. influence from cvs-diff-ignore-marks.
  2110.  
  2111. The flags in the variable cvs-diff-flags will be passed to ``cvs diff''.
  2112.  
  2113. The resulting diffs are placed in the cvs-fileinfo->cvs-diff-buffer."
  2114.  
  2115.   (interactive "P")
  2116.   (if (not (listp cvs-diff-flags))
  2117.       (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
  2118.   (save-some-buffers)
  2119.   (message "cvsdiffing...")
  2120.   (let ((marked-file-list (cvs-diffable
  2121.          (cvs-get-marked
  2122.           (or (and ignore-marks (not cvs-diff-ignore-marks))
  2123.               (and (not ignore-marks) cvs-diff-ignore-marks))))))
  2124.     (while marked-file-list
  2125.       (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
  2126.                       (car marked-file-list)))
  2127.         (local-def-directory (file-name-as-directory
  2128.                   (cvs-fileinfo->dir
  2129.                    (tin-cookie cvs-cookie-handle
  2130.                            (car marked-file-list))))))
  2131.     (message "cvsdiffing %s..."
  2132.          (cvs-fileinfo->file-name fileinfo-to-diff))
  2133.  
  2134.     ;; FIXME:  this seems messy to test and set buffer name at this point....
  2135.     (if (not (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
  2136.         (cvs-set-fileinfo->cvs-diff-buffer fileinfo-to-diff
  2137.                            (concat "*cvs-diff-"
  2138.                                (cvs-fileinfo->file-name
  2139.                             fileinfo-to-diff)
  2140.                                "-in-"
  2141.                                local-def-directory
  2142.                                "*")))
  2143.     (display-buffer (get-buffer-create
  2144.              (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff)))
  2145.     (set-buffer (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
  2146.     (setq buffer-read-only nil)
  2147.     (setq default-directory local-def-directory)
  2148.     (erase-buffer)
  2149.     (insert (format "=== cd %s\n" default-directory))
  2150.     (insert (format "=== cvs %s\n\n"
  2151.             (mapconcat 'cvs-quote-multiword-string
  2152.                    (nconc (if cvs-cvsroot
  2153.                           (list "-d" cvs-cvsroot "diff")
  2154.                         '("diff"))
  2155.                       (copy-sequence cvs-diff-flags)
  2156.                       (list (cvs-fileinfo->file-name
  2157.                          fileinfo-to-diff)))
  2158.                    " ")))
  2159.     (if (apply 'call-process cvs-program nil t t
  2160.            (nconc (if cvs-cvsroot
  2161.                   (list "-d" cvs-cvsroot "diff")
  2162.                 '("diff"))
  2163.               (copy-sequence cvs-diff-flags)
  2164.               (list (cvs-fileinfo->file-name fileinfo-to-diff))))
  2165.         (message "cvsdiffing %s... Done."
  2166.              (cvs-fileinfo->file-name fileinfo-to-diff))
  2167.       (message "cvsdiffing %s... No differences found."
  2168.            (cvs-fileinfo->file-name fileinfo-to-diff)))
  2169.     (goto-char (point-max))
  2170.     (setq marked-file-list (cdr marked-file-list)))))
  2171.   (message "cvsdiffing... Done."))
  2172.  
  2173. ;;----------
  2174. (defun cvs-mode-diff-head (&optional ignore-marks)
  2175.   "Diff the selected files against the head revisions in the repository.
  2176.  
  2177. If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
  2178. considered to be selected.  An optional prefix argument will invert the
  2179. influence from cvs-diff-ignore-marks.
  2180.  
  2181. The flags in the variable cvs-diff-flags will be passed to ``cvs diff -rHEAD''.
  2182.  
  2183. The resulting diffs are placed in the cvs-fileinfo->cvs-diff-buffer."
  2184.  
  2185.   (interactive "P")
  2186.   (if (not (listp cvs-diff-flags))
  2187.       (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
  2188.   (save-some-buffers)
  2189.   (message "cvsdiffing...")
  2190.   (let ((marked-file-list (cvs-diffable
  2191.          (cvs-get-marked
  2192.           (or (and ignore-marks (not cvs-diff-ignore-marks))
  2193.               (and (not ignore-marks) cvs-diff-ignore-marks))))))
  2194.     (while marked-file-list
  2195.       (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
  2196.                       (car marked-file-list)))
  2197.         (local-def-directory (file-name-as-directory
  2198.                   (cvs-fileinfo->dir
  2199.                    (tin-cookie cvs-cookie-handle
  2200.                            (car marked-file-list))))))
  2201.     (message "cvsdiffing %s..."
  2202.          (cvs-fileinfo->file-name fileinfo-to-diff))
  2203.  
  2204.     ;; FIXME:  this seems messy to test and set buffer name at this point....
  2205.     (if (not (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
  2206.         (cvs-set-fileinfo->cvs-diff-buffer fileinfo-to-diff
  2207.                            (concat "*cvs-diff-"
  2208.                                (cvs-fileinfo->file-name
  2209.                             fileinfo-to-diff)
  2210.                                "-in-"
  2211.                                local-def-directory
  2212.                                "*")))
  2213.     (display-buffer (get-buffer-create
  2214.              (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff)))
  2215.     (set-buffer (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
  2216.     (setq buffer-read-only nil)
  2217.     (setq default-directory local-def-directory)
  2218.     (erase-buffer)
  2219.     (insert (format "=== cd %s\n" default-directory))
  2220.     (insert (format "=== cvs %s\n\n"
  2221.             (mapconcat 'cvs-quote-multiword-string
  2222.                    (nconc (if cvs-cvsroot
  2223.                           (list "-d" cvs-cvsroot "diff" "-rHEAD")
  2224.                         '("diff" "-rHEAD"))
  2225.                       (copy-sequence cvs-diff-flags)
  2226.                       (list (cvs-fileinfo->file-name
  2227.                          fileinfo-to-diff)))
  2228.                    " ")))
  2229.     (if (apply 'call-process cvs-program nil t t
  2230.            (nconc (if cvs-cvsroot
  2231.                   (list "-d" cvs-cvsroot "diff" "-rHEAD")
  2232.                 '("diff" "-rHEAD"))
  2233.               (copy-sequence cvs-diff-flags)
  2234.               (list (cvs-fileinfo->file-name fileinfo-to-diff))))
  2235.         (message "cvsdiffing %s... Done."
  2236.              (cvs-fileinfo->file-name fileinfo-to-diff))
  2237.       (message "cvsdiffing %s... No differences found."
  2238.            (cvs-fileinfo->file-name fileinfo-to-diff)))
  2239.     (goto-char (point-max))
  2240.     (setq marked-file-list (cdr marked-file-list)))))
  2241.   (message "cvsdiffing... Done."))
  2242.  
  2243. ;;----------
  2244. (defun cvs-mode-diff-backup (&optional ignore-marks)
  2245.   "Diff the files against the backup file.
  2246. This command can be used on files that are marked with \"Merged\"
  2247. or \"Conflict\" in the *cvs* buffer.
  2248.  
  2249. If the variable cvs-diff-ignore-marks is non-nil any marked files will
  2250. not be considered to be selected.  An optional prefix argument will
  2251. invert the influence from cvs-diff-ignore-marks.
  2252.  
  2253. The flags in cvs-diff-flags will be passed to ``diff''.
  2254.  
  2255. The resulting diffs are placed in the cvs-fileinfo->backup-diff-buffer."
  2256.  
  2257.   (interactive "P")
  2258.   (if (not (listp cvs-diff-flags))
  2259.       (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
  2260.   (save-some-buffers)
  2261.   (let ((marked-file-list (cvs-filter
  2262.                (function cvs-backup-diffable)
  2263.                (cvs-get-marked
  2264.                 (or
  2265.                  (and ignore-marks (not cvs-diff-ignore-marks))
  2266.                  (and (not ignore-marks) cvs-diff-ignore-marks))))))
  2267.     (if (null marked-file-list)
  2268.     (error "No ``Conflict'' or ``Merged'' file selected!"))
  2269.     (message "backup diff...")
  2270.     (while marked-file-list
  2271.       (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
  2272.                       (car marked-file-list)))
  2273.         (local-def-directory (file-name-as-directory
  2274.                   (cvs-fileinfo->dir
  2275.                    (tin-cookie cvs-cookie-handle
  2276.                            (car marked-file-list)))))
  2277.         (backup-temp-files (cvs-diff-backup-extractor
  2278.                 (tin-cookie cvs-cookie-handle
  2279.                         (car marked-file-list)))))
  2280.     (message "backup diff %s..."
  2281.          (cvs-fileinfo->file-name fileinfo-to-diff))
  2282.  
  2283.     ;; FIXME:  this seems messy to test and set buffer name at this point....
  2284.     (if (not (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
  2285.         (cvs-set-fileinfo->backup-diff-buffer fileinfo-to-diff
  2286.                           (concat "*cvs-diff-"
  2287.                               (cvs-fileinfo->backup-file
  2288.                                fileinfo-to-diff)
  2289.                               "-to-"
  2290.                               (cvs-fileinfo->file-name
  2291.                                fileinfo-to-diff)
  2292.                               "-in"
  2293.                               local-def-directory
  2294.                               "*")))
  2295.     (display-buffer (get-buffer-create
  2296.              (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff)))
  2297.     (set-buffer (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
  2298.     (setq buffer-read-only nil)
  2299.     (setq default-directory local-def-directory)
  2300.     (erase-buffer)
  2301.     (insert (format "=== cd %s\n" default-directory))
  2302.     (insert (format "=== %s %s\n\n"
  2303.             cvs-diff-program
  2304.             (mapconcat 'cvs-quote-multiword-string
  2305.                    (nconc (copy-sequence cvs-diff-flags)
  2306.                       backup-temp-files)
  2307.                    " ")))
  2308.     (apply 'call-process cvs-diff-program nil t t
  2309.            (nconc (copy-sequence cvs-diff-flags) backup-temp-files))
  2310.     (goto-char (point-max))
  2311.     (message "backup diff %s... Done."
  2312.          (cvs-fileinfo->file-name fileinfo-to-diff))
  2313.     (setq marked-file-list (cdr marked-file-list)))))
  2314.   (message "backup diff... Done."))
  2315.  
  2316. ;;----------
  2317. (defun cvs-mode-diff-vendor (&optional ignore-marks)
  2318.   "Diff the revisions merged into the current file.  I.e. show what changes
  2319. were merged in.
  2320.  
  2321. This command can be used on files that are marked with \"Merged\"
  2322. or \"Conflict\" in the *cvs* buffer.
  2323.  
  2324. If the variable cvs-diff-ignore-marks is non-nil any marked files will
  2325. not be considered to be selected.  An optional prefix argument will
  2326. invert the influence from cvs-diff-ignore-marks.
  2327.  
  2328. The flags in cvs-diff-flags will be passed to ``diff''.
  2329.  
  2330. The resulting diffs are placed in the cvs-fileinfo->vendor-diff-buffer."
  2331.  
  2332.   (interactive "P")
  2333.   (if (not (listp cvs-diff-flags))
  2334.       (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
  2335.   (save-some-buffers)
  2336.   (let ((marked-file-list (cvs-filter
  2337.                (function cvs-vendor-diffable)
  2338.                (cvs-get-marked
  2339.                 (or
  2340.                  (and ignore-marks (not cvs-diff-ignore-marks))
  2341.                  (and (not ignore-marks) cvs-diff-ignore-marks))))))
  2342.     (if (null marked-file-list)
  2343.     (error "No ``Conflict'' or ``Merged'' file selected!"))
  2344.     (message "vendor diff...")
  2345.     (while marked-file-list
  2346.       (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
  2347.                       (car marked-file-list)))
  2348.         (local-def-directory (file-name-as-directory
  2349.                   (cvs-fileinfo->dir
  2350.                    (tin-cookie cvs-cookie-handle
  2351.                            (car marked-file-list)))))
  2352.         (vendor-temp-files (cvs-diff-vendor-extractor
  2353.                 (tin-cookie cvs-cookie-handle
  2354.                         (car marked-file-list)))))
  2355.     (message "vendor diff %s..."
  2356.              (cvs-fileinfo->file-name fileinfo-to-diff))
  2357.     (if (not (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
  2358.         (cvs-set-fileinfo->vendor-diff-buffer fileinfo-to-diff
  2359.                           (concat "*cvs-diff-"
  2360.                               (cvs-fileinfo->file-name
  2361.                                fileinfo-to-diff)
  2362.                               "-of-"
  2363.                               (cvs-fileinfo->base-revision
  2364.                                fileinfo-to-diff)
  2365.                               "-to-"
  2366.                               (cvs-fileinfo->head-revision
  2367.                                fileinfo-to-diff)
  2368.                               "-in-"
  2369.                               local-def-directory
  2370.                               "*")))
  2371.     (display-buffer (get-buffer-create
  2372.              (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff)))
  2373.     (set-buffer (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
  2374.     (setq buffer-read-only nil)
  2375.     (setq default-directory local-def-directory)
  2376.     (erase-buffer)
  2377.     (insert (format "=== cd %s\n" default-directory))
  2378.     (insert (format "=== %s %s\n\n"
  2379.             cvs-diff-program
  2380.             (mapconcat 'cvs-quote-multiword-string
  2381.                    (nconc (copy-sequence cvs-diff-flags)
  2382.                       vendor-temp-files)
  2383.                    " ")))
  2384.     (apply 'call-process cvs-diff-program nil t t
  2385.            (nconc (copy-sequence cvs-diff-flags) vendor-temp-files))
  2386.     (goto-char (point-max))
  2387.     (message "vendor diff %s... Done."
  2388.              (cvs-fileinfo->file-name fileinfo-to-diff))
  2389.     (while vendor-temp-files
  2390.       (cvs-kill-buffer-visiting (car vendor-temp-files))
  2391.       (delete-file (car vendor-temp-files))
  2392.       (setq vendor-temp-files (cdr vendor-temp-files)))
  2393.     (setq marked-file-list (cdr marked-file-list)))))
  2394.   (message "vendor diff... Done."))
  2395.  
  2396. ;;----------
  2397. (defun cvs-backup-diffable (tin)
  2398.   "Check if the TIN is backup-diffable.
  2399. It must have a backup file to be diffable."
  2400.  
  2401.   (file-readable-p
  2402.    (cvs-fileinfo->backup-file (tin-cookie cvs-cookie-handle tin))))
  2403.  
  2404. ;;----------
  2405. (defun cvs-vendor-diffable (tin)
  2406.   "Check if the TIN is vendor-diffable.
  2407. It must have head and base revision info to be diffable."
  2408.  
  2409.   (and
  2410.    (cvs-fileinfo->base-revision (tin-cookie cvs-cookie-handle tin))
  2411.    (cvs-fileinfo->head-revision (tin-cookie cvs-cookie-handle tin))))
  2412.  
  2413. ;;----------
  2414. (defun cvs-diff-backup-extractor (fileinfo)
  2415.   "Return the filename and the name of the backup file as a list.
  2416. Signal an error if there is no backup file."
  2417.  
  2418.   (if (not (file-readable-p (cvs-fileinfo->backup-file fileinfo)))
  2419.       (error "%s has no backup file."
  2420.          (concat
  2421.           (file-name-as-directory (cvs-fileinfo->dir fileinfo))
  2422.           (cvs-fileinfo->file-name fileinfo))))
  2423.   (list    (cvs-fileinfo->backup-file fileinfo)
  2424.      (cvs-fileinfo->file-name fileinfo)))
  2425.  
  2426. ;;----------
  2427. (defun cvs-diff-vendor-extractor (fileinfo)
  2428.   "Retrieve and return the filenames of the vendor branch revisions as a list.
  2429. Signal an error if there is no info for the vendor revisions."
  2430.  
  2431.   (list (cvs-retrieve-revision-to-tmpfile fileinfo
  2432.                       (cvs-fileinfo->base-revision
  2433.                        fileinfo))
  2434.     (cvs-retrieve-revision-to-tmpfile fileinfo
  2435.                       (cvs-fileinfo->head-revision
  2436.                        fileinfo))))
  2437.  
  2438. ;;----------
  2439. (defun cvs-mode-find-file-other-window (pos)
  2440.   "Select a buffer containing the file in another window.
  2441. Args:  POS."
  2442.  
  2443.   (interactive "d")
  2444.   (let ((tin (tin-locate cvs-cookie-handle pos)))
  2445.     (if tin
  2446.     (let ((type (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin))))
  2447.       (cond
  2448.        ((or (eq type 'REMOVED)
  2449.         (eq type 'CVS-REMOVED))
  2450.         (error "Can't visit a removed file."))
  2451.        ((eq type 'DIRCHANGE)
  2452.         (let ((obuf (current-buffer))
  2453.           (odir default-directory))
  2454.           (setq default-directory
  2455.             (file-name-as-directory
  2456.              (cvs-fileinfo->dir
  2457.               (tin-cookie cvs-cookie-handle tin))))
  2458.           (dired-other-window default-directory)
  2459.           (set-buffer obuf)
  2460.           (setq default-directory odir)))
  2461.        (t
  2462.         (find-file-other-window (cvs-full-path tin)))))
  2463.       (error "There is no file to find."))))
  2464.  
  2465. ;;----------
  2466. (defun cvs-fileinfo->full-path (fileinfo)
  2467.   "Return the full path for the file that is described in FILEINFO."
  2468.  
  2469.   (concat
  2470.    (file-name-as-directory
  2471.     (cvs-fileinfo->dir fileinfo))
  2472.    (cvs-fileinfo->file-name fileinfo)))
  2473.  
  2474. ;;----------
  2475. (defun cvs-full-path (tin)
  2476.   "Return the full path for the file that is described in TIN."
  2477.  
  2478.   (cvs-fileinfo->full-path (tin-cookie cvs-cookie-handle tin)))
  2479.  
  2480. ;;----------
  2481. (defun cvs-mode-find-file (pos)
  2482.   "Select a buffer containing the file in another window.
  2483. Args:  POS."
  2484.  
  2485.   (interactive "d")
  2486.   (let* ((cvs-buf (current-buffer))
  2487.      (tin (tin-locate cvs-cookie-handle pos)))
  2488.     (if tin
  2489.     (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  2490.            (type (cvs-fileinfo->type fileinfo)))
  2491.       (cond
  2492.        ((or (eq type 'REMOVED)
  2493.         (eq type 'CVS-REMOVED))
  2494.         (error "Can't visit a removed file."))
  2495.        ((eq type 'DIRCHANGE)
  2496.         (let ((odir default-directory))
  2497.           (setq default-directory
  2498.             (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
  2499.           (dired default-directory)
  2500.           (set-buffer cvs-buf)
  2501.           (setq default-directory odir))) 
  2502.        (t
  2503.         (find-file (cvs-full-path tin)))))
  2504.       (error "There is no file to find."))))
  2505.  
  2506. ;;----------
  2507. (defun cvs-mode-mark-all-files ()
  2508.   "Mark all files.
  2509. Directories are not marked."
  2510.  
  2511.   (interactive)
  2512.   (cookie-map (function (lambda (cookie)
  2513.               (cond
  2514.                ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
  2515.                 (cvs-set-fileinfo->marked cookie t)
  2516.                 t))))
  2517.           cvs-cookie-handle))
  2518.  
  2519. ;;----------
  2520. (defun cvs-mode-unmark (pos)
  2521.   "Unmark a fileinfo.
  2522. Args:  POS."
  2523.  
  2524.   (interactive "d")
  2525.   (let* ((tin (tin-locate cvs-cookie-handle pos))
  2526.      (sel (tin-cookie cvs-cookie-handle tin)))
  2527.     (cond
  2528.      ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
  2529.       (cookie-map
  2530.        (function (lambda (f dir)
  2531.            (cond
  2532.             ((cvs-dir-member-p f dir)
  2533.              (cvs-set-fileinfo->marked f nil)
  2534.              t))))
  2535.        cvs-cookie-handle
  2536.        (cvs-fileinfo->dir sel)))
  2537.      (t
  2538.       (cvs-set-fileinfo->marked sel nil)
  2539.       (tin-invalidate cvs-cookie-handle tin)
  2540.       (tin-goto-next cvs-cookie-handle pos 1)))))
  2541.  
  2542. ;;----------
  2543. (defun cvs-mode-unmark-all-files ()
  2544.   "Unmark all files.
  2545. Directories are also unmarked, but that doesn't matter, since
  2546. they should always be unmarked."
  2547.  
  2548.   (interactive)
  2549.   (cookie-map (function (lambda (cookie)
  2550.               (cvs-set-fileinfo->marked cookie nil)
  2551.               t))
  2552.           cvs-cookie-handle))
  2553.  
  2554. ;;----------
  2555. (defun cvs-do-removal (tins)
  2556.   "Remove files.
  2557. Args:  TINS.
  2558.  
  2559. TINS is a list of tins that the user wants to delete.  The files are deleted.
  2560. If the type of the tin is 'UNKNOWN or 'UNKNOWN-DIR the tin is removed from the
  2561. buffer.  If it is anything else the file is added to a list that should be `cvs
  2562. remove'd and the tin is changed to be of type 'REMOVED.
  2563.  
  2564. Returns a list of tins files that should be `cvs remove'd."
  2565.  
  2566.   (cvs-use-temp-buffer)
  2567.   (mapcar 'cvs-insert-full-path tins)
  2568.   (cond
  2569.    ((and tins (yes-or-no-p (format "Delete %d files? " (length tins))))
  2570.     (let (files-to-remove)
  2571.       (while tins
  2572.     (let* ((tin (car tins))
  2573.            (fileinfo (tin-cookie cvs-cookie-handle tin))
  2574.            (filepath (cvs-full-path tin))
  2575.            (type (cvs-fileinfo->type fileinfo)))
  2576.       (if (or (eq type 'REMOVED)
  2577.           (eq type 'CVS-REMOVED))
  2578.           nil
  2579.         ;; if it doesn't exist, as a file or directory, ignore it
  2580.         (cond ((file-directory-p filepath)
  2581.            (call-process cvs-rmdir-program nil nil nil filepath))
  2582.           ((file-exists-p filepath)
  2583.            (delete-file filepath)))
  2584.         (if (or (eq type 'UNKNOWN)
  2585.              (eq type 'UNKNOWN-DIR)
  2586.              (eq type 'MOVE-AWAY))
  2587.         (tin-delete cvs-cookie-handle tin)
  2588.           (setq files-to-remove (cons tin files-to-remove))
  2589.           (cvs-set-fileinfo->type fileinfo 'REMOVED)
  2590.           (cvs-set-fileinfo->handled fileinfo nil)
  2591.           (tin-invalidate cvs-cookie-handle tin))))
  2592.     (setq tins (cdr tins)))
  2593.       files-to-remove))
  2594.    (t nil)))
  2595.  
  2596. ;;----------
  2597. (defun cvs-mode-remove-file ()
  2598.   "Remove all marked files."
  2599.  
  2600.   (interactive)
  2601.   (let ((files-to-remove (cvs-do-removal (cvs-get-marked))))
  2602.     (if (null files-to-remove)
  2603.     nil
  2604.       (cvs-use-temp-buffer)
  2605.       (message "removing from repository...")
  2606.       (if (cvs-execute-list files-to-remove cvs-program
  2607.                 (if cvs-cvsroot
  2608.                 (list "-d" cvs-cvsroot "remove")
  2609.                   '("remove"))
  2610.                 "removing %s from repository...")
  2611.       (error "CVS exited with non-zero exit status.")
  2612.     (message "removing from repository... Done.")))))
  2613.  
  2614. ;;----------
  2615. (defun cvs-mode-undo-local-changes ()
  2616.   "Undo local changes to all marked files.
  2617. The file is removed and `cvs update FILE' is run."
  2618.  
  2619.   (interactive)
  2620.   (let ((tins-to-undo (cvs-get-marked)))
  2621.     (cvs-use-temp-buffer)
  2622.     (mapcar 'cvs-insert-full-path tins-to-undo)
  2623.     (cond
  2624.      ((and tins-to-undo (yes-or-no-p (format "Undo changes to %d files? "
  2625.                          (length tins-to-undo))))
  2626.       (let (files-to-update)
  2627.     (while tins-to-undo
  2628.       (let* ((tin (car tins-to-undo))
  2629.          (fileinfo (tin-cookie cvs-cookie-handle tin))
  2630.          (type (cvs-fileinfo->type fileinfo)))
  2631.         (cond
  2632.          ((or
  2633.            (eq type 'UPDATED)
  2634.            (eq type 'PATCHED)
  2635.            (eq type 'MODIFIED)
  2636.            (eq type 'MERGED)
  2637.            (eq type 'CONFLICT)
  2638.            (eq type 'CVS-REMOVED)
  2639.            (eq type 'REM-CONFLICT)
  2640.            (eq type 'MOVE-AWAY)
  2641.            (eq type 'REMOVED))
  2642.           (if (not (eq type 'REMOVED))
  2643.           (delete-file (cvs-full-path tin)))
  2644.           (setq files-to-update (cons tin files-to-update))
  2645.           (cvs-set-fileinfo->type fileinfo 'UPDATED)
  2646.           (cvs-set-fileinfo->handled fileinfo t)
  2647.           (tin-invalidate cvs-cookie-handle tin))
  2648.  
  2649.          ((eq type 'MOD-CONFLICT)
  2650.           (error "Use cvs-mode-add instead on %s."
  2651.              (cvs-fileinfo->file-name fileinfo)))
  2652.  
  2653.          ((eq type 'REM-CONFLICT)
  2654.           (error "Can't deal with a file you have removed and recreated."))
  2655.  
  2656.          ((eq type 'DIRCHANGE)
  2657.           (error "Undo on directories not supported (yet)."))
  2658.  
  2659.          ((eq type 'ADDED)
  2660.           (error "There is no old revision to get for %s"
  2661.              (cvs-fileinfo->file-name fileinfo)))
  2662.          (t (error "cvs-mode-undo-local-changes: can't handle an %s"
  2663.                type)))
  2664.  
  2665.         (setq tins-to-undo (cdr tins-to-undo))))
  2666.     (cvs-use-temp-buffer)
  2667.     (message "Re-getting files from repository...")
  2668.     (if (cvs-execute-list files-to-update cvs-program
  2669.                   (if cvs-cvsroot
  2670.                   (list "-d" cvs-cvsroot "update")
  2671.                 '("update"))
  2672.                   "Re-getting %s from repository...")
  2673.         (error "CVS exited with non-zero exit status.")
  2674.       (message "Re-getting files from repository... Done.")))))))
  2675.  
  2676. ;;----------
  2677. (defun cvs-mode-acknowledge ()
  2678.   "Remove all marked files from the buffer."
  2679.  
  2680.   (interactive)
  2681.   (mapcar (function (lambda (tin)
  2682.               (tin-delete cvs-cookie-handle tin)))
  2683.       (cvs-get-marked)))
  2684.  
  2685. ;;----------
  2686. (defun cvs-mode-unmark-up (pos)
  2687.   "Unmark the file on the previous line.
  2688. Takes one argument POS, a buffer position."
  2689.  
  2690.   (interactive "d")
  2691.   (let ((tin (tin-goto-previous cvs-cookie-handle pos 1)))
  2692.     (cond
  2693.      (tin
  2694.       (cvs-set-fileinfo->marked (tin-cookie cvs-cookie-handle tin)
  2695.                 nil)
  2696.       (tin-invalidate cvs-cookie-handle tin)))))
  2697.  
  2698. ;;----------
  2699. (defun cvs-mode-previous-line (arg)
  2700.   "Go to the previous line.
  2701. If a prefix argument is given, move by that many lines."
  2702.  
  2703.   (interactive "p")
  2704.   (tin-goto-previous cvs-cookie-handle (point) arg))
  2705.  
  2706. ;;----------
  2707. (defun cvs-mode-next-line (arg)
  2708.   "Go to the next line.
  2709. If a prefix argument is given, move by that many lines."
  2710.  
  2711.   (interactive "p")
  2712.   (tin-goto-next cvs-cookie-handle (point) arg))
  2713.  
  2714. ;;----------
  2715. (defun cvs-add-file-update-buffer (tin)
  2716.   "Sub-function to cvs-mode-add.  Internal use only.  Update the display.  Return
  2717. non-nil if `cvs add' should be called on this file.
  2718. Args:  TIN.
  2719.  
  2720. Returns 'DIR, 'ADD, 'ADD-DIR, or 'RESURRECT."
  2721.  
  2722.   (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
  2723.     (cond
  2724.      ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN-DIR)
  2725.       (cvs-set-fileinfo->full-log fileinfo "new directory added with cvs-mode-add")
  2726.       'ADD-DIR)
  2727.      ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
  2728.       (cvs-set-fileinfo->type fileinfo 'ADDED)
  2729.       (cvs-set-fileinfo->full-log fileinfo "new file added with cvs-mode-add")
  2730.       (tin-invalidate cvs-cookie-handle tin)
  2731.       'ADD)
  2732.      ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
  2733.       (cvs-set-fileinfo->type fileinfo 'UPDATED)
  2734.       (cvs-set-fileinfo->full-log fileinfo "file resurrected with cvs-mode-add")
  2735.       (cvs-set-fileinfo->handled fileinfo t)
  2736.       (tin-invalidate cvs-cookie-handle tin)
  2737.       'RESURRECT))))
  2738.  
  2739. ;;----------
  2740. (defun cvs-add-sub (cvs-buf candidates)
  2741.   "Internal use only.
  2742. Args:  CVS-BUF CANDIDATES.
  2743.  
  2744. CANDIDATES is a list of tins.  Updates the CVS-BUF and returns a list of lists.
  2745. The first list is unknown tins that shall be `cvs add -m msg'ed.
  2746. The second list is unknown directory tins that shall be `cvs add -m msg'ed.
  2747. The third list is removed files that shall be `cvs add'ed (resurrected)."
  2748.  
  2749.   (let (add add-dir resurrect)
  2750.     (while candidates
  2751.       (let ((type (cvs-add-file-update-buffer (car candidates))))
  2752.     (cond ((eq type 'ADD)
  2753.            (setq add (cons (car candidates) add)))
  2754.           ((eq type 'ADD-DIR)
  2755.            (setq add-dir (cons (car candidates) add-dir)))
  2756.           ((eq type 'RESURRECT)
  2757.            (setq resurrect (cons (car candidates) resurrect)))))
  2758.       (setq candidates (cdr candidates)))
  2759.     (list add add-dir resurrect)))
  2760.  
  2761. ;;----------
  2762. (defun cvs-mode-add ()
  2763.   "Add marked files to the cvs repository."
  2764.  
  2765.   (interactive)
  2766.   (let* ((buf (current-buffer))
  2767.      (marked (cvs-get-marked))
  2768.      (result (cvs-add-sub buf marked))
  2769.      (added (car result))
  2770.      (newdirs (car (cdr result)))
  2771.      (resurrect (car (cdr (cdr result))))
  2772.      (msg (if (or added newdirs)
  2773.           (read-from-minibuffer "Enter description: "))))
  2774.  
  2775.     (if (or resurrect (or added newdirs))
  2776.     (cvs-use-temp-buffer))
  2777.  
  2778.     (cond (resurrect
  2779.        (message "Resurrecting files from repository...")
  2780.        (if (cvs-execute-list resurrect
  2781.                  cvs-program
  2782.                  (if cvs-cvsroot
  2783.                      (list "-d" cvs-cvsroot "add")
  2784.                    '("add"))
  2785.                  "Resurrecting %s from repository...")
  2786.            (error "CVS exited with non-zero exit status.")
  2787.          (message "Resurrecting files from repository... Done."))))
  2788.  
  2789.     (cond (added
  2790.        (message "Adding new files to repository...")
  2791.        (if (cvs-execute-list added
  2792.                  cvs-program
  2793.                  (if cvs-cvsroot
  2794.                      (list "-d" cvs-cvsroot "add" "-m" msg)
  2795.                    (list "add" "-m" msg))
  2796.                  "Adding %s to repository...")
  2797.            (error "CVS exited with non-zero exit status.")
  2798.          (message "Adding new files to repository... Done."))))
  2799.  
  2800.     (cond (newdirs
  2801.        (message "Adding new directories to repository...")
  2802.        (if (cvs-execute-list newdirs
  2803.                  cvs-program
  2804.                  (if cvs-cvsroot
  2805.                      (list "-d" cvs-cvsroot "add" "-m" msg)
  2806.                    (list "add" "-m" msg))
  2807.                  "Adding %s to repository...")
  2808.            (error "CVS exited with non-zero exit status.")
  2809.          (while newdirs
  2810.            (let* ((tin (car newdirs))
  2811.               (fileinfo (tin-cookie cvs-cookie-handle tin))
  2812.               (newdir (cvs-fileinfo->file-name fileinfo)))
  2813.          (cvs-set-fileinfo->dir fileinfo
  2814.                     (concat (cvs-fileinfo->dir fileinfo)
  2815.                         "/"
  2816.                         newdir))
  2817.          (cvs-set-fileinfo->type fileinfo 'DIRCHANGE)
  2818.          (cvs-set-fileinfo->file-name fileinfo ".")
  2819.          (tin-invalidate cvs-cookie-handle tin)
  2820.          (setq newdirs (cdr newdirs))))
  2821.          ;; FIXME: this should really run cvs-update-no-prompt on the
  2822.          ;; subdir and insert everthing in the current list.
  2823.          (message "You must re-update to visit the new directories."))))))
  2824.  
  2825. ;;----------
  2826. (defun cvs-mode-ignore ()
  2827.   "Arrange so that CVS ignores the selected files and directories.
  2828. This command ignores files/dirs that are flagged as `Unknown'."
  2829.  
  2830.   (interactive)
  2831.   (mapcar (function (lambda (tin)
  2832.               (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  2833.                  (type (cvs-fileinfo->type fileinfo)))
  2834.             (cond ((or (eq type 'UNKNOWN)
  2835.                    (eq type 'UNKNOWN-DIR))
  2836.                    (cvs-append-to-ignore fileinfo)
  2837.                    (tin-delete cvs-cookie-handle tin))))))
  2838.       (cvs-get-marked)))
  2839.  
  2840. ;;----------
  2841. (defun cvs-append-to-ignore (fileinfo)
  2842.   "Append the file in fileinfo to the .cvsignore file"
  2843.  
  2844.   (save-window-excursion
  2845.     (set-buffer (find-file-noselect (concat (file-name-as-directory
  2846.                          (cvs-fileinfo->dir fileinfo))
  2847.                         ".cvsignore")))
  2848.     (goto-char (point-max))
  2849.     (if (not (zerop (current-column)))
  2850.     (insert "\n"))
  2851.     (insert (cvs-fileinfo->file-name fileinfo) "\n")
  2852.     (if cvs-sort-ignore-file
  2853.     (sort-lines nil (point-min) (point-max)))
  2854.     (save-buffer)))
  2855.  
  2856. ;;----------
  2857. (defun cvs-mode-status ()
  2858.   "Show cvs status for all marked files."
  2859.  
  2860.   (interactive)
  2861.   (save-some-buffers)
  2862.   (if (not (listp cvs-status-flags))
  2863.       (error "cvs-status-flags should be set using cvs-set-status-flags."))
  2864.   (let ((marked (cvs-get-marked nil t)))
  2865.     (cvs-use-temp-buffer)
  2866.     (message "Running cvs status ...")
  2867.     (if (cvs-execute-list marked
  2868.               cvs-program
  2869.               (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
  2870.                   (list "-Q" "status")
  2871.                   cvs-status-flags)
  2872.               "Running cvs -Q status %s...")
  2873.     (error "CVS exited with non-zero exit status.")
  2874.       (message "Running cvs -Q status ... Done."))))
  2875.  
  2876. ;;----------
  2877. (defun cvs-mode-log ()
  2878.   "Display the cvs log of all selected files."
  2879.  
  2880.   (interactive)
  2881.   (if (not (listp cvs-log-flags))
  2882.       (error "cvs-log-flags should be set using cvs-set-log-flags."))
  2883.   (let ((marked (cvs-get-marked nil t)))
  2884.     (cvs-use-temp-buffer)
  2885.     (message "Running cvs log ...")
  2886.     (if (cvs-execute-list marked
  2887.               cvs-program
  2888.               (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
  2889.                   (list "log")
  2890.                   cvs-log-flags)
  2891.               "Running cvs log %s...")
  2892.     (error "CVS exited with non-zero exit status.")
  2893.       (message "Running cvs log ... Done."))))
  2894.  
  2895. ;;----------
  2896. (defun cvs-mode-tag ()
  2897.   "Run 'cvs tag' on all selected files."
  2898.  
  2899.   (interactive)
  2900.   (if (not (listp cvs-tag-flags))
  2901.       (error "cvs-tag-flags should be set using cvs-set-tag-flags."))
  2902.   (let ((marked (cvs-get-marked nil t))
  2903.     (tag-args (cvs-make-list (read-string "Tag name (and flags): "))))
  2904.     (cvs-use-temp-buffer)
  2905.     (message "Running cvs tag ...")
  2906.     (if (cvs-execute-list marked
  2907.               cvs-program
  2908.               (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
  2909.                   (list "tag")
  2910.                   cvs-tag-flags
  2911.                   tag-args)
  2912.               "Running cvs tag %s...")
  2913.     (error "CVS exited with non-zero exit status.")
  2914.       (message "Running cvs tag ... Done."))))
  2915.  
  2916. ;;----------
  2917. (defun cvs-mode-rtag ()
  2918.   "Run 'cvs rtag' on all selected files."
  2919.  
  2920.   (interactive)
  2921.   (if (not (listp cvs-rtag-flags))
  2922.       (error "cvs-rtag-flags should be set using cvs-set-rtag-flags."))
  2923.   (let ((marked (cvs-get-marked nil t))
  2924.     ;; FIXME:  should give selection from the modules file
  2925.     (module-name (read-string "Module name: "))
  2926.     ;; FIXME:  should also ask for an existing tag *or* date
  2927.     (rtag-args (cvs-make-list (read-string "Tag name (and flags): "))))
  2928.     (cvs-use-temp-buffer)
  2929.     (message "Running cvs rtag ...")
  2930.     (if (cvs-execute-list marked
  2931.               cvs-program
  2932.               (append (if cvs-cvsroot (list "-d" cvs-cvsroot)) 
  2933.                   (list "rtag")
  2934.                   cvs-rtag-flags
  2935.                   rtag-args
  2936.                   (list module-name))
  2937.               "Running cvs rtag %s...")
  2938.     (error "CVS rtag exited with non-zero exit status.")
  2939.       (message "Running cvs rtag ... Done."))))
  2940.  
  2941. ;;----------
  2942. (defun cvs-mode-byte-compile-files ()
  2943.   "Run byte-compile-file on all selected files that end in '.el'."
  2944.  
  2945.   (interactive)
  2946.   (let ((marked (cvs-get-marked)))
  2947.     (while marked
  2948.       (let ((filename (cvs-full-path (car marked))))
  2949.     (if (string-match "\\.el$" filename)
  2950.         (byte-compile-file filename)))
  2951.       (setq marked (cdr marked)))))
  2952.  
  2953. ;;----------
  2954. (defun cvs-insert-full-path (tin)
  2955.   "Insert full path to the file described in TIN in the current buffer."
  2956.  
  2957.   (insert (format "%s\n" (cvs-full-path tin))))
  2958.  
  2959. ;;----------
  2960. (defun cvs-mode-add-change-log-entry-other-window (pos)
  2961.   "Add a ChangeLog entry in the ChangeLog of the current directory.
  2962. Args:  POS."
  2963.  
  2964.   (interactive "d")
  2965.   (let* ((cvs-buf (current-buffer))
  2966.      (odir default-directory)
  2967.      (obfname buffer-file-name)
  2968.      (tin (tin-locate cvs-cookie-handle pos))
  2969.      (fileinfo (tin-cookie cvs-cookie-handle tin))
  2970.      (fname (cvs-fileinfo->file-name fileinfo))
  2971.      (dname (file-name-as-directory (cvs-fileinfo->dir fileinfo))))
  2972.     (setq change-log-default-name nil)    ; this rarely correct in 19.28
  2973.     (setq buffer-file-name (cond (fname
  2974.                    fname)
  2975.                   (t
  2976.                    nil)))
  2977.     (setq default-directory (cond (dname
  2978.                     dname)
  2979.                    (t
  2980.                     odir)))
  2981.     (add-change-log-entry-other-window)
  2982.     (set-buffer cvs-buf)
  2983.     (setq default-directory odir)
  2984.     (setq buffer-file-name obfname)))
  2985.  
  2986. ;;----------
  2987. (defun print-cvs-tin (foo)
  2988.   "Debug utility."
  2989.  
  2990.   (let ((cookie (tin-cookie cvs-cookie-handle foo))
  2991.     (stream (get-buffer-create "pcl-cvs-debug")))
  2992.     (princ "==============\n" stream)
  2993.     (princ (cvs-fileinfo->file-name cookie) stream)
  2994.     (princ "\n" stream)
  2995.     (princ (cvs-fileinfo->dir cookie) stream)
  2996.     (princ "\n" stream)
  2997.     (princ (cvs-fileinfo->full-log cookie) stream)
  2998.     (princ "\n" stream)
  2999.     (princ (cvs-fileinfo->marked cookie) stream)
  3000.     (princ "\n" stream)))
  3001.  
  3002. ;;----------
  3003. ;; NOTE: the variable cvs-emerge-tmp-head-file will be "free" when compiling
  3004. (defun cvs-mode-emerge (pos)
  3005.   "Emerge appropriate revisions of the selected file.
  3006. Args:  POS."
  3007.  
  3008.   (interactive "d")
  3009.   (let* ((cvs-buf (current-buffer))
  3010.      (tin (tin-locate cvs-cookie-handle pos)))
  3011.     (if (boundp 'cvs-emerge-tmp-head-file)
  3012.     (error "There can only be one emerge session active at a time."))
  3013.     (if tin
  3014.     (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  3015.            (default-directory
  3016.          (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
  3017.            (type (cvs-fileinfo->type fileinfo)))
  3018.       (cond
  3019.        ((eq type 'MODIFIED)        ; merge repository head rev. with working file
  3020.         (require 'emerge)
  3021.         (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
  3022.           (cvs-retrieve-revision-to-tmpfile fileinfo))
  3023.         (unwind-protect
  3024.         (if (not (emerge-files
  3025.               t                        ; arg
  3026.               (cvs-fileinfo->full-path fileinfo)         ; file-A
  3027.               ;; this is an un-avoidable compiler reference to a free variable
  3028.               cvs-emerge-tmp-head-file            ; file-B
  3029.               (cvs-fileinfo->full-path fileinfo)        ; file-out
  3030.               nil                        ; start-hooks
  3031.               '(lambda ()                    ; quit-hooks
  3032.                  (delete-file cvs-emerge-tmp-head-file)
  3033.                  (makunbound 'cvs-emerge-tmp-head-file))))
  3034.             (error "Emerge session failed"))))
  3035.  
  3036.        ;; re-do the same merge rcsmerge supposedly just did....
  3037.        ((or (eq type 'MERGED)
  3038.         (eq type 'CONFLICT))    ; merge backup-working=A, head=B, base=ancestor
  3039.         (require 'emerge)
  3040.         (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
  3041.           (cvs-retrieve-revision-to-tmpfile fileinfo
  3042.                             (cvs-fileinfo->head-revision
  3043.                              fileinfo)))
  3044.         (let ((cvs-emerge-tmp-backup-working-file
  3045.            (cvs-fileinfo->backup-file fileinfo))
  3046.           (cvs-emerge-tmp-ancestor-file
  3047.            (cvs-retrieve-revision-to-tmpfile fileinfo
  3048.                              (cvs-fileinfo->base-revision
  3049.                               fileinfo))))
  3050.           (unwind-protect
  3051.           (if (not (emerge-files-with-ancestor
  3052.                 t                        ; arg
  3053.                 cvs-emerge-tmp-backup-working-file        ; file-A
  3054.                 ;; this is an un-avoidable compiler reference to a free variable
  3055.                 cvs-emerge-tmp-head-file            ; file-B
  3056.                 cvs-emerge-tmp-ancestor-file        ; file-ancestor
  3057.                 (cvs-fileinfo->full-path fileinfo)        ; file-out
  3058.                 nil                        ; start-hooks
  3059.                 '(lambda ()                    ; quit-hooks
  3060.                    (delete-file cvs-emerge-tmp-backup-file)
  3061.                    (delete-file cvs-emerge-tmp-ancestor-file)
  3062.                    (delete-file cvs-emerge-tmp-head-file)
  3063.                    (makunbound 'cvs-emerge-tmp-head-file))))
  3064.               (error "Emerge session failed")))))
  3065.        (t
  3066.         (error "Can only e-merge \"Modified\", \"Merged\" or \"Conflict\" files"))))
  3067.       (error "There is no file to e-merge."))))
  3068.  
  3069. ;;----------
  3070. ;; NOTE: the variable ediff-version may be "free" when compiling
  3071. (defun cvs-mode-ediff (pos)
  3072.   "Ediff appropriate revisions of the selected file.
  3073. Args:  POS."
  3074.  
  3075.   (interactive "d")
  3076.   (if (boundp 'cvs-ediff-tmp-head-file)
  3077.       (error "There can only be one ediff session active at a time."))
  3078.   (require 'ediff)
  3079.   (if (and (boundp 'ediff-version)
  3080.        (>= (string-to-number ediff-version) 2.0)) ; FIXME real number?
  3081.       (run-ediff-from-cvs-buffer pos)
  3082.     (cvs-old-ediff-interface pos)))
  3083.  
  3084. (defun cvs-old-ediff-interface (pos)
  3085.   "Emerge like interface for older ediffs.
  3086. Args:  POS"
  3087.  
  3088.   (let* ((cvs-buf (current-buffer))
  3089.      (tin (tin-locate cvs-cookie-handle pos)))
  3090.     (if tin
  3091.     (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
  3092.            (type (cvs-fileinfo->type fileinfo)))
  3093.       (cond
  3094.        ((eq type 'MODIFIED)        ; diff repository head rev. with working file
  3095.         ;; should this be inside the unwind-protect, and should the
  3096.         ;; makeunbound be an unwindform?
  3097.         (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
  3098.           (cvs-retrieve-revision-to-tmpfile fileinfo))
  3099.         (unwind-protect
  3100.         (if (not (ediff-files    ; check correct ordering of args
  3101.               (cvs-fileinfo->full-path fileinfo)         ; file-A
  3102.               ;; this is an un-avoidable compiler reference to a free variable
  3103.               cvs-ediff-tmp-head-file            ; file-B
  3104.               '(lambda ()                    ; startup-hooks
  3105.                  (make-local-hook 'ediff-cleanup-hooks)
  3106.                  (add-hook 'ediff-cleanup-hooks
  3107.                        '(lambda ()
  3108.                       (ediff-janitor)
  3109.                       (delete-file cvs-ediff-tmp-head-file)
  3110.                       (makunbound 'cvs-ediff-tmp-head-file))
  3111.                        nil t))))
  3112.             (error "Ediff session failed"))))
  3113.  
  3114.        ;; look at the merge rcsmerge supposedly just did....
  3115.        ((or (eq type 'MERGED)
  3116.         (eq type 'CONFLICT))    ; diff backup-working=A, head=B, base=ancestor
  3117.         (if (not (boundp 'ediff-version))
  3118.         (error "ediff version way too old for 3-way diff"))
  3119.         (if (<= (string-to-number ediff-version) 1.9) ; FIXME real number?
  3120.         (error "ediff version %s too old for 3-way diff" ediff-version))
  3121.         (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
  3122.           (cvs-retrieve-revision-to-tmpfile fileinfo
  3123.                             (cvs-fileinfo->head-revision
  3124.                              fileinfo)))
  3125.         (let ((cvs-ediff-tmp-backup-working-file
  3126.            (cvs-fileinfo->backup-file fileinfo))
  3127.           (cvs-ediff-tmp-ancestor-file
  3128.            (cvs-retrieve-revision-to-tmpfile fileinfo
  3129.                              (cvs-fileinfo->base-revision
  3130.                               fileinfo))))
  3131.           (unwind-protect
  3132.           (if (not (ediff-files3 ; check correct ordering of args
  3133.                 cvs-ediff-tmp-backup-working-file        ; file-A
  3134.                 ;; this is an un-avoidable compiler reference to a free variable
  3135.                 cvs-ediff-tmp-head-file            ; file-B
  3136.                 cvs-ediff-tmp-ancestor-file            ; file-ancestor
  3137.                 '(lambda ()                    ; start-hooks
  3138.                    (make-local-hook 'ediff-cleanup-hooks)
  3139.                    (add-hook 'ediff-cleanup-hooks
  3140.                      '(lambda ()
  3141.                         (ediff-janitor)
  3142.                         (delete-file cvs-ediff-tmp-backup-file)
  3143.                         (delete-file cvs-ediff-tmp-ancestor-file)
  3144.                         (delete-file cvs-ediff-tmp-head-file)
  3145.                         (makunbound 'cvs-ediff-tmp-head-file))
  3146.                      nil t))))
  3147.               (error "Ediff session failed")))))
  3148.  
  3149.        ((not (or (eq type 'UNKNOWN)
  3150.              (eq type 'UNKNOWN-DIR))) ; i.e. UPDATED or PATCHED ????
  3151.         ;; this should really diff the current working file with the previous
  3152.         ;; rev. on the current branch (i.e. not the head, since that's what
  3153.         ;; the current file should be)
  3154.         (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
  3155.           (cvs-retrieve-revision-to-tmpfile fileinfo
  3156.                             (read-string "Rev #/tag to diff against: "
  3157.                                  (cvs-fileinfo->head-revision
  3158.                                   fileinfo))))
  3159.         (unwind-protect
  3160.         (if (not (ediff-files    ; check correct ordering of args
  3161.               (cvs-fileinfo->full-path fileinfo)         ; file-A
  3162.               ;; this is an un-avoidable compiler reference to a free variable
  3163.               cvs-ediff-tmp-head-file            ; file-B
  3164.               '(lambda ()                    ; startup-hooks
  3165.                  (make-local-hook 'ediff-cleanup-hooks)
  3166.                  (add-hook 'ediff-cleanup-hooks
  3167.                        '(lambda ()
  3168.                       (ediff-janitor)
  3169.                       (delete-file cvs-ediff-tmp-head-file)
  3170.                       (makunbound 'cvs-ediff-tmp-head-file))
  3171.                        nil t))))
  3172.             (error "Ediff session failed"))))
  3173.        (t
  3174.         (error "Can not ediff \"Unknown\" files"))))
  3175.       (error "There is no file to ediff."))))
  3176.  
  3177. ;;----------
  3178. (defun cvs-retrieve-revision-to-tmpfile (fileinfo &optional revision)
  3179.   "Retrieve the latest revision of the file in FILEINFO to a temporary file.
  3180. If second optional argument REVISION is given, retrieve that revision instead."
  3181.  
  3182.   (let
  3183.       ((temp-name (make-temp-name
  3184.            (concat (file-name-as-directory
  3185.                 (or (getenv "TMPDIR") "/tmp"))
  3186.                "pcl-cvs." revision))))
  3187.     (cvs-kill-buffer-visiting temp-name)
  3188.     (if (and revision
  3189.          (stringp revision)
  3190.          (not (string= revision "")))
  3191.     (message "Retrieving revision %s..." revision)
  3192.       (message "Retrieving latest revision..."))
  3193.     (let ((res (call-process cvs-shell nil nil nil "-c"
  3194.                  (concat cvs-program " update -p "
  3195.                      (if (and revision
  3196.                           (stringp revision)
  3197.                           (not (string= revision "")))
  3198.                      (concat "-r " revision " ")
  3199.                        "")
  3200.                      (cvs-fileinfo->full-path fileinfo)
  3201.                      " > " temp-name))))
  3202.       (if (and res (not (and (integerp res) (zerop res))))
  3203.       (error "Something went wrong retrieving revision %s: %s"
  3204.          revision res))
  3205.  
  3206.       (if revision
  3207.       (message "Retrieving revision %s... Done." revision)
  3208.     (message "Retrieving latest revision... Done."))
  3209.       (save-excursion
  3210.     (set-buffer (find-file-noselect temp-name))
  3211.     (rename-buffer (concat " " (file-name-nondirectory temp-name)) t))
  3212.       temp-name)))
  3213.  
  3214. ;;----------
  3215. (defun cvs-kill-buffer-visiting (filename)
  3216.   "If there is any buffer visiting FILENAME, kill it (without confirmation)."
  3217.  
  3218.   (let ((l (buffer-list)))
  3219.     (while l
  3220.       (if (string= (buffer-file-name (car l)) filename)
  3221.       (kill-buffer (car l)))
  3222.       (setq l (cdr l)))))
  3223.  
  3224. ;;----------
  3225. (defun cvs-change-cvsroot ()
  3226.   "Ask for a new cvsroot."
  3227.  
  3228.   (interactive)
  3229.   (cvs-set-cvsroot (read-file-name "New CVSROOT: " cvs-cvsroot)))
  3230.  
  3231. ;;----------
  3232. (defun cvs-set-cvsroot (newroot)
  3233.   "Change the cvsroot."
  3234.  
  3235.   (if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
  3236.       (y-or-n-p (concat "Warning:  no CVSROOT found inside repository."
  3237.                 " Change cvs-cvsroot anyhow?")))
  3238.       (setq cvs-cvsroot newroot)))
  3239.  
  3240. ;;----------
  3241. (defun cvs-set-diff-flags ()
  3242.   "Ask for new setting of cvs-diff-flags."
  3243.  
  3244.   (interactive)
  3245.   (let ((old-value (mapconcat 'identity
  3246.                   (copy-sequence cvs-diff-flags) " ")))
  3247.     (setq cvs-diff-flags
  3248.       (cvs-make-list (read-string "Diff flags: " old-value)))))
  3249.  
  3250. ;;----------
  3251. (defun cvs-set-update-optional-flags ()
  3252.   "Ask for new setting of cvs-update-optional-flags."
  3253.   
  3254.   (interactive)
  3255.   (let ((old-value (mapconcat 'identity
  3256.                   (copy-sequence cvs-update-optional-flags) " ")))
  3257.     (setq cvs-update-optional-flags
  3258.       (cvs-make-list (read-string "Update optional flags: " old-value)))))
  3259.  
  3260. ;;----------
  3261. (defun cvs-set-status-flags ()
  3262.   "Ask for new setting of cvs-status-flags."
  3263.  
  3264.   (interactive)
  3265.   (let ((old-value (mapconcat 'identity
  3266.                   (copy-sequence cvs-status-flags) " ")))
  3267.     (setq cvs-status-flags
  3268.       (cvs-make-list (read-string "Status flags: " old-value)))))
  3269.  
  3270. ;;----------
  3271. (defun cvs-set-log-flags ()
  3272.   "Ask for new setting of cvs-log-flags."
  3273.  
  3274.   (interactive)
  3275.   (let ((old-value (mapconcat 'identity
  3276.                   (copy-sequence cvs-log-flags) " ")))
  3277.     (setq cvs-log-flags
  3278.       (cvs-make-list (read-string "Log flags: " old-value)))))
  3279.  
  3280. ;;----------
  3281. (defun cvs-set-tag-flags ()
  3282.   "Ask for new setting of cvs-tag-flags."
  3283.  
  3284.   (interactive)
  3285.   (let ((old-value (mapconcat 'identity
  3286.                   (copy-sequence cvs-tag-flags) " ")))
  3287.     (setq cvs-tag-flags
  3288.       (cvs-make-list (read-string "Tag flags: " old-value)))))
  3289.  
  3290. ;;----------
  3291. (defun cvs-set-rtag-flags ()
  3292.   "Ask for new setting of cvs-rtag-flags."
  3293.  
  3294.   (interactive)
  3295.   (let ((old-value (mapconcat 'identity
  3296.                   (copy-sequence cvs-rtag-flags) " ")))
  3297.     (setq cvs-rtag-flags
  3298.       (cvs-make-list (read-string "Rtag flags: " old-value)))))
  3299.  
  3300. ;;----------
  3301. (if (string-match "XEmacs" emacs-version)
  3302.     (progn
  3303.       ;; now marked to autload in pcl-cvs-xemacs
  3304.       ;(autoload 'pcl-cvs-fontify "pcl-cvs-xemacs")
  3305.       (add-hook 'cvs-mode-hook 'pcl-cvs-fontify)))
  3306.  
  3307. (defun cvs-changelog-name (directory)
  3308.   "Return the name of the ChangeLog file that handles DIRECTORY.
  3309. This is in DIRECTORY or one of its parents.
  3310. Signal an error if we can't find an appropriate ChangeLog file."
  3311.   (let ((dir (file-name-as-directory directory))
  3312.         file)
  3313.     (while (and dir
  3314.                 (not (file-exists-p 
  3315.                       (setq file (expand-file-name "ChangeLog" dir)))))
  3316.       (let ((last dir))
  3317.         (setq dir (file-name-directory (directory-file-name dir)))
  3318.         (if (equal last dir)
  3319.             (setq dir nil))))
  3320.     (or dir
  3321.         (error "Can't find ChangeLog for %s" directory))
  3322.     file))
  3323.  
  3324. (defun cvs-narrow-changelog ()
  3325.   "Narrow to the top page of the current buffer, a ChangeLog file.
  3326. Actually, the narrowed region doesn't include the date line.
  3327. A \"page\" in a ChangeLog file is the area between two dates."
  3328.   (or (eq major-mode 'change-log-mode)
  3329.       (error "cvs-narrow-changelog: current buffer isn't a ChangeLog"))
  3330.  
  3331.   (goto-char (point-min))
  3332.  
  3333.   ;; Skip date line and subsequent blank lines.
  3334.   (forward-line 1)
  3335.   (if (looking-at "[ \t\n]*\n")
  3336.       (goto-char (match-end 0)))
  3337.  
  3338.   (let ((start (point)))
  3339.     (forward-page 1)
  3340.     (narrow-to-region start (point))
  3341.     (goto-char (point-min))))
  3342.  
  3343. (defun cvs-changelog-paragraph ()
  3344.   "Return the bounds of the ChangeLog paragraph containing point.
  3345. If we are between paragraphs, return the previous paragraph."
  3346.   (save-excursion
  3347.     (beginning-of-line)
  3348.     (if (looking-at "^[ \t]*$")
  3349.         (skip-chars-backward " \t\n" (point-min)))
  3350.     (list (progn
  3351.             (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit)
  3352.                 (goto-char (match-end 0)))
  3353.             (point))
  3354.           (if (re-search-forward "^[ \t\n]*$" nil t)
  3355.               (match-beginning 0)
  3356.             (point)))))
  3357.  
  3358. (defun cvs-changelog-subparagraph ()
  3359.   "Return the bounds of the ChangeLog subparagraph containing point.
  3360. A subparagraph is a block of non-blank lines beginning with an asterisk.
  3361. If we are between sub-paragraphs, return the previous subparagraph."
  3362.   (save-excursion
  3363.     (end-of-line)
  3364.     (if (search-backward "*" nil t)
  3365.         (list (progn (beginning-of-line) (point))
  3366.               (progn 
  3367.                 (forward-line 1)
  3368.                 (if (re-search-forward "^[ \t]*[\n*]" nil t)
  3369.                     (match-beginning 0)
  3370.                   (point-max))))
  3371.       (list (point) (point)))))
  3372.  
  3373. (defun cvs-changelog-entry ()
  3374.   "Return the bounds of the ChangeLog entry containing point.
  3375. The variable `cvs-changelog-full-paragraphs' decides whether an
  3376. \"entry\" is a paragraph or a subparagraph; see its documentation string
  3377. for more details."
  3378.   (if cvs-changelog-full-paragraphs
  3379.       (cvs-changelog-paragraph)
  3380.     (cvs-changelog-subparagraph)))
  3381.  
  3382. ;; NOTE: the variable user-full-name may be "free" when compiling
  3383. (defun cvs-changelog-ours-p ()
  3384.   "See if ChangeLog entry at point is for the current user, today.
  3385. Return non-nil iff it is."
  3386.   ;; Code adapted from add-change-log-entry.
  3387.   (or (looking-at (concat (regexp-quote (substring (current-time-string)
  3388.                            0 10))
  3389.               ".* "
  3390.               (regexp-quote (substring (current-time-string) -4))
  3391.               "[ \t]+"
  3392.               (regexp-quote (if (and (boundp 'add-log-full-name)
  3393.                          add-log-full-name)
  3394.                         add-log-full-name
  3395.                       (or (and (boundp 'user-full-name)
  3396.                            user-full-name)
  3397.                           (user-full-name))))
  3398.               "  <"
  3399.               (regexp-quote (if (and
  3400.                          (boundp 'add-log-mailing-address)
  3401.                          add-log-mailing-address)
  3402.                         add-log-mailing-address
  3403.                       (user-mail-address)))))
  3404.       ;; New ChangeLog format (as of XEmacs 20.3)
  3405.       (looking-at (concat (funcall add-log-time-format)
  3406.               "[  \t]+"
  3407.               (regexp-quote (if (and (boundp 'add-log-full-name)
  3408.                          add-log-full-name)
  3409.                         add-log-full-name
  3410.                       (or (and (boundp 'user-full-name)
  3411.                            user-full-name)
  3412.                           (user-full-name))))
  3413.               " *<"
  3414.               (regexp-quote (if (and
  3415.                          (boundp 'add-log-mailing-address)
  3416.                          add-log-mailing-address)
  3417.                         add-log-mailing-address
  3418.                       (user-mail-address)))))))
  3419.  
  3420.               
  3421.  
  3422. (defun cvs-relative-path (base child)
  3423.   "Return a directory path relative to BASE for CHILD.
  3424. If CHILD doesn't seem to be in a subdirectory of BASE, just return 
  3425. the full path to CHILD."
  3426.   (let ((base (file-name-as-directory (expand-file-name base)))
  3427.         (child (expand-file-name child)))
  3428.     (or (string= base (substring child 0 (length base)))
  3429.         (error "cvs-relative-path: %s isn't in %s" child base))
  3430.     (substring child (length base))))
  3431.  
  3432. (defun cvs-changelog-entries (file)
  3433.   "Return the ChangeLog entries for FILE, and the ChangeLog they came from.
  3434. The return value looks like this:
  3435.   (LOGBUFFER (ENTRYSTART . ENTRYEND) ...)
  3436. where LOGBUFFER is the name of the ChangeLog buffer, and each
  3437. \(ENTRYSTART . ENTRYEND\) pair is a buffer region."
  3438.   (save-excursion
  3439.     (set-buffer (find-file-noselect
  3440.                  (cvs-changelog-name
  3441.                   (file-name-directory
  3442.                    (expand-file-name file)))))
  3443.     (or (eq major-mode 'change-log-mode)
  3444.     (change-log-mode))
  3445.     (goto-char (point-min))
  3446.     (if (looking-at "[ \t\n]*\n")
  3447.         (goto-char (match-end 0)))
  3448.     (if (not (cvs-changelog-ours-p))
  3449.         (list (current-buffer))
  3450.       (save-restriction
  3451.         (cvs-narrow-changelog)
  3452.         (goto-char (point-min))
  3453.  
  3454.         ;; Search for the name of FILE relative to the ChangeLog.  If that
  3455.         ;; doesn't occur anywhere, they're not using full relative
  3456.         ;; filenames in the ChangeLog, so just look for FILE; we'll accept
  3457.         ;; some false positives.
  3458.         (let ((pattern (cvs-relative-path
  3459.                         (file-name-directory buffer-file-name) file)))
  3460.           (if (or (string= pattern "")
  3461.                   (not (save-excursion
  3462.                          (search-forward pattern nil t))))
  3463.               (setq pattern file))
  3464.  
  3465.           (let (texts)
  3466.             (while (search-forward pattern nil t)
  3467.               (let ((entry (cvs-changelog-entry)))
  3468.                 (setq texts (cons entry texts))
  3469.                 (goto-char (elt entry 1))))
  3470.  
  3471.             (cons (current-buffer) texts)))))))
  3472.  
  3473. (defun cvs-changelog-insert-entries (buffer regions)
  3474.   "Insert those regions in BUFFER specified in REGIONS.
  3475. Sort REGIONS front-to-back first."
  3476.   (let ((regions (sort regions 'car-less-than-car))
  3477.         (last))
  3478.     (while regions
  3479.       (if (and last (< last (car (car regions))))
  3480.           (newline))
  3481.       (setq last (elt (car regions) 1))
  3482.       (apply 'insert-buffer-substring buffer (car regions))
  3483.       (setq regions (cdr regions)))))
  3484.  
  3485. (defun cvs-union (set1 set2)
  3486.   "Return the union of SET1 and SET2, according to `equal'."
  3487.   (while set2
  3488.     (or (member (car set2) set1)
  3489.         (setq set1 (cons (car set2) set1)))
  3490.     (setq set2 (cdr set2)))
  3491.   set1)
  3492.  
  3493. (defun cvs-insert-changelog-entries (files)
  3494.   "Given a list of files FILES, insert the ChangeLog entries for them."
  3495.   (let ((buffer-entries nil))
  3496.  
  3497.     ;; Add each buffer to buffer-entries, and associate it with the list
  3498.     ;; of entries we want from that file.
  3499.     (while files
  3500.       (let* ((entries (cvs-changelog-entries (car files)))
  3501.              (pair (assq (car entries) buffer-entries)))
  3502.         (if pair
  3503.             (setcdr pair (cvs-union (cdr pair) (cdr entries)))
  3504.           (setq buffer-entries (cons entries buffer-entries))))
  3505.       (setq files (cdr files)))
  3506.  
  3507.     ;; Now map over each buffer in buffer-entries, sort the entries for
  3508.     ;; each buffer, and extract them as strings.
  3509.     (while buffer-entries
  3510.       (cvs-changelog-insert-entries (car (car buffer-entries))
  3511.                                     (cdr (car buffer-entries)))
  3512.       (if (and (cdr buffer-entries) (cdr (car buffer-entries)))
  3513.           (newline))
  3514.       (setq buffer-entries (cdr buffer-entries)))))
  3515.  
  3516. (defun cvs-edit-delete-common-indentation ()
  3517.   "Unindent the current buffer rigidly until at least one line is flush left."
  3518.   (save-excursion
  3519.     (let ((common 100000))
  3520.       (goto-char (point-min))
  3521.       (while (< (point) (point-max))
  3522.         (if (not (looking-at "^[ \t]*$"))
  3523.             (setq common (min common (current-indentation))))
  3524.         (forward-line 1))
  3525.       (indent-rigidly (point-min) (point-max) (- common)))))
  3526.  
  3527. (defun cvs-mode-changelog-commit ()
  3528.   "Check in all marked files, or the current file.
  3529. Ask the user for a log message in a buffer.
  3530.  
  3531. This is just like `\\[cvs-mode-commit]', except that it tries to provide
  3532. appropriate default log messages by looking at the ChangeLog.  The
  3533. idea is to write your ChangeLog entries first, and then use this
  3534. command to commit your changes.
  3535.  
  3536. To select default log text, we:
  3537. - find the ChangeLog entries for the files to be checked in,
  3538. - verify that the top entry in the ChangeLog is on the current date
  3539.   and by the current user; if not, we don't provide any default text,
  3540. - search the ChangeLog entry for paragraphs containing the names of
  3541.   the files we're checking in, and finally
  3542. - use those paragraphs as the log text."
  3543.  
  3544.   (interactive)
  3545.  
  3546.   (let* ((cvs-buf (current-buffer))
  3547.          (marked (cvs-filter (function cvs-committable)
  3548.                              (cvs-get-marked))))
  3549.     (if (null marked)
  3550.         (error "Nothing to commit!")
  3551.       (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
  3552.       (goto-char (point-min))
  3553.  
  3554.       (erase-buffer)
  3555.       (cvs-insert-changelog-entries
  3556.        (mapcar (lambda (tin)
  3557.                  (let ((cookie (tin-cookie cvs-cookie-handle tin)))
  3558.                    (expand-file-name 
  3559.                     (cvs-fileinfo->file-name cookie)
  3560.                     (cvs-fileinfo->dir cookie))))
  3561.                marked))
  3562.       (cvs-edit-delete-common-indentation)
  3563.  
  3564.       (cvs-edit-mode)
  3565.       (make-local-variable 'cvs-commit-list)
  3566.       (setq cvs-commit-list marked)
  3567.       (message "Press C-c C-c when you are done editing."))))
  3568.  
  3569. (provide 'pcl-cvs)
  3570.  
  3571. ;;; pcl-cvs.el ends here
  3572.